This work is a project for the DSC531: Statistical Simulation course. The project focuses on the Exploratory Data Analysis (EDA) of the given Performance dataset, which includes marks obtained by students in different subjects.
The aim was to first clean (if necessary) the data and then perform a full Exploratory Data Analysis (with summary statistics, plots and statistical hypothesis testing), which would help to understand the variation within the variables. Additionally, it was requested to find correlations or any patterns between variables if they exist, and more depending on the questions that will be raised.
The current list of objects from the environment are removed, in order to ensure a clean R environment before any operations
# Remove the list of objects from the environment, just to
# ensure a clean R environment before any operations
rm(list=ls())
The libraries which are going to used are loaded
# Import library for the functionality that will render an R DataFrame as an HTML table
# knitr create tables in LaTeX, HTML or Markdown
# Specifically, the function which is in interest is the knitr::kable()
library(knitr)
# Library that checks for missing values
# Will be needed for the function miss_var_summary()
library(naniar)
# Libraries for data visualization
library(ggplot2)
# Will be using the ggarrange() function in order to draw multiple ggplots on the same plot
library(ggpubr)
# Library that is used for data manipulation
# Will mainly be used for the pipeline operations %>% and for the filter() and bind() functions
library(dplyr)
##
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
##
## filter, lag
## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, union
# Library that which will be used to look at the samples' skewness
library(moments)
# The library of 'fastDummies' will be utilized in order to obtain
# the one-hot representation of the categorical variables
library(fastDummies)
# The corrplot package provided a visual exploratory tool on correlation matrix
# which helped on the detection of hidden patterns among variables
library('corrplot')
## corrplot 0.90 loaded
# Companion to Applied Regression package
library('car')
## Loading required package: carData
##
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
##
## recode
# For the Linear Models which use Lasso, the glmnet library utilized,
# which provides efficient procedures for fitting Linear Regression models
library(glmnet)
## Loading required package: Matrix
## Loaded glmnet 4.1-2
# Using the gbm for the boosting models, specifically for the gradient boosting trees
library(gbm)
## Loaded gbm 2.1.8
# Package that has functions to streamline the model training process for complex regression and classification problems
library(caret)
## Loading required package: lattice
Setting a seed to make the script reproducible
# Make the script reproducible
set.seed(420)
The Performance dataset consists of the marks secured by students in various subjects. It is already known and given, that the variables in the data are:
Initially, the dataset was loaded directly from the csv file which contained the Performance dataset
# Read the Performance dataset from the csv file
data <- read.csv('Performance.csv', header = TRUE)
# Confirming that the occurred data variable is a DataFrame
class(data)
## [1] "data.frame"
The first ten rows of the dataframe are presented with the utilization of the kable table generator
# Observation of the dataset
# Printing the first ten rows-data points of the dataset
kable(head(data, 10))
| gender | race.ethnicity | parental.level.of.education | lunch | test.preparation.course | math.score | reading.score | writing.score |
|---|---|---|---|---|---|---|---|
| female | group B | bachelor’s degree | standard | none | 72 | 72 | 74 |
| female | group C | some college | standard | completed | 69 | 90 | 88 |
| female | group B | master’s degree | standard | none | 90 | 95 | 93 |
| male | group A | associate’s degree | free/reduced | none | 47 | 57 | 44 |
| male | group C | some college | standard | none | 76 | 78 | 75 |
| female | group B | associate’s degree | standard | none | 71 | 83 | 78 |
| female | group B | some college | standard | completed | 88 | 95 | 92 |
| male | group B | some college | free/reduced | none | 40 | 43 | 39 |
| male | group D | high school | free/reduced | completed | 64 | 64 | 67 |
| female | group B | high school | free/reduced | none | 38 | 60 | 50 |
It was noticed that indeed the columns-variables are the eight variables which were described earlier.
Next, it was examined whether the data had missing (NA) values. The miss_var_summary() function of the naniar package was used in order to summarize the missing values in each variable.
# Confirming that the dataset has no NA values
miss_var_summary(data) # Get a summary for the missing values of the different variables
## # A tibble: 8 × 3
## variable n_miss pct_miss
## <chr> <int> <dbl>
## 1 gender 0 0
## 2 race.ethnicity 0 0
## 3 parental.level.of.education 0 0
## 4 lunch 0 0
## 5 test.preparation.course 0 0
## 6 math.score 0 0
## 7 reading.score 0 0
## 8 writing.score 0 0
cat('Total null values in dataset:', sum(is.na(data)))
## Total null values in dataset: 0
# Heatplot of missingness across the entire data frame
vis_miss(data)
Fortunately, there were no missing values at all. Therefore no imputation was needed for the values of the different variables.
Following, the structure and types of the variables are going to be studied.
# Observe the structure and data type of each column of the DataFrame,
# by utilizing the str() function
str(data)
## 'data.frame': 1000 obs. of 8 variables:
## $ gender : Factor w/ 2 levels "female","male": 1 1 1 2 2 1 1 2 2 1 ...
## $ race.ethnicity : Factor w/ 5 levels "group A","group B",..: 2 3 2 1 3 2 2 2 4 2 ...
## $ parental.level.of.education: Factor w/ 6 levels "associate's degree",..: 2 5 4 1 5 1 5 5 3 3 ...
## $ lunch : Factor w/ 2 levels "free/reduced",..: 2 2 2 1 2 2 2 1 1 1 ...
## $ test.preparation.course : Factor w/ 2 levels "completed","none": 2 1 2 2 2 2 1 2 1 2 ...
## $ math.score : int 72 69 90 47 76 71 88 40 64 38 ...
## $ reading.score : int 72 90 95 57 78 83 95 43 64 60 ...
## $ writing.score : int 74 88 93 44 75 78 92 39 67 50 ...
Since it was concluded that for different versions of R, sometimes categorical columns were not directly loaded as Factors but as characters, the specific found columns were manually casted to Factors
# Loops through the columns of the DataFrame and for the character
# and change their type to Factors
for (colname in colnames(data)){
# Checks if the column is from the character class
# and changes its type to Factor
if (class(data[[colname]]) == "character")
data[[colname]] <- as.factor(data[[colname]])
}
# Observe the structure and data type of each column of the DataFrame,
# by utilizing the str() function
str(data)
## 'data.frame': 1000 obs. of 8 variables:
## $ gender : Factor w/ 2 levels "female","male": 1 1 1 2 2 1 1 2 2 1 ...
## $ race.ethnicity : Factor w/ 5 levels "group A","group B",..: 2 3 2 1 3 2 2 2 4 2 ...
## $ parental.level.of.education: Factor w/ 6 levels "associate's degree",..: 2 5 4 1 5 1 5 5 3 3 ...
## $ lunch : Factor w/ 2 levels "free/reduced",..: 2 2 2 1 2 2 2 1 1 1 ...
## $ test.preparation.course : Factor w/ 2 levels "completed","none": 2 1 2 2 2 2 1 2 1 2 ...
## $ math.score : int 72 69 90 47 76 71 88 40 64 38 ...
## $ reading.score : int 72 90 95 57 78 83 95 43 64 60 ...
## $ writing.score : int 74 88 93 44 75 78 92 39 67 50 ...
As it is shown, there are 1000 datapoints-observations in the dataset.
Additionally, the three score variables math.score, reading,score, writing,score) were integers, while the rest of the variables (gender, race.ethnicity, parental.level.of.education, lunch, test.preparation.course) were Factors (variables that are used to categorize the stored data).
The Factor levels of the categorical variables were inspected, in order to distinguish the unique values of the categorical variables
# Loops through the columns of the DataFrame and for the factor columns prints
# the different factor levels (unique values of the categorical variables)
for (colname in colnames(data)){
# Checks if the column is from the factor class
if (class(data[[colname]]) == "factor")
cat("Unique values of", colname, ": ", levels(data[[colname]]), '\n')
}
## Unique values of gender : female male
## Unique values of race.ethnicity : group A group B group C group D group E
## Unique values of parental.level.of.education : associate's degree bachelor's degree high school master's degree some college some high school
## Unique values of lunch : free/reduced standard
## Unique values of test.preparation.course : completed none
As it is distinguished, the different categorical variables have the following unique values:
From the levels of parental level of education it can be easily seen that it would make sense for its different levels-values to follow a specific order, thus to be sorted (since for example a master’s degree is considered higher education than high school).
In order to accurately sort the levels of educations, some things regarding the different levels must be specified. Obviously, some high school and high school are the lowest levels of education for the current dataset. Regarding associate degrees and college diplomas, they both typically last two to three years, and they are considered as a level of qualification above a high school diploma and below a bachelor’s degree. Thus, a person who has only completed some college is considered “less educated” than a person who has completed an associate degree. Obviously, since a bachelor’s degree requires three to four years, it will be ranked above the aforementioned levels, but below master’s degree, since a bachelor’s degree is pre-required in most of the master’s programmes.
Therefore, the order of the factors was changed into the following order:
# Changing the ordering of the levels for the Factor "parental.level.of.education"
data$parental.level.of.education <- factor(data$parental.level.of.education ,
levels = c("some high school", "high school", "some college",
"associate's degree", "bachelor's degree", "master's degree"))
# Confirmation that the order has been changed successfully
cat("New Factor levels of", colname, ": ", levels(data$parental.level.of.education), '\n')
## New Factor levels of writing.score : some high school high school some college associate's degree bachelor's degree master's degree
Subsequently, some summary statistics were analyzed, in order to get an initial idea of how the values of the variables are distributed.
# Summary for the Factor variables
kable(summary(Filter(is.factor, data)))
| gender | race.ethnicity | parental.level.of.education | lunch | test.preparation.course | |
|---|---|---|---|---|---|
| female:518 | group A: 89 | some high school :179 | free/reduced:355 | completed:358 | |
| male :482 | group B:190 | high school :196 | standard :645 | none :642 | |
| NA | group C:319 | some college :226 | NA | NA | |
| NA | group D:262 | associate’s degree:222 | NA | NA | |
| NA | group E:140 | bachelor’s degree :118 | NA | NA | |
| NA | NA | master’s degree : 59 | NA | NA |
# Summary for the score integer variables
kable(summary(Filter(is.integer, data)))
| math.score | reading.score | writing.score | |
|---|---|---|---|
| Min. : 0.00 | Min. : 17.00 | Min. : 10.00 | |
| 1st Qu.: 57.00 | 1st Qu.: 59.00 | 1st Qu.: 57.75 | |
| Median : 66.00 | Median : 70.00 | Median : 69.00 | |
| Mean : 66.09 | Mean : 69.17 | Mean : 68.05 | |
| 3rd Qu.: 77.00 | 3rd Qu.: 79.00 | 3rd Qu.: 79.00 | |
| Max. :100.00 | Max. :100.00 | Max. :100.00 |
Even from a brief summary, it can be seen that the minimum of score in maths was zero, which indicates that some extreme cases exist. This is going to be further analyzed later with some visualization.
Additionally, it is strange to see that most of the individuals did not take the test preparation course. Most of the parents have either completed some college or have associate’s degree, while only a few have a master’s degree.
Next, boxplots for the score variables were plotted in order to visualize the distribution of scores
# boxplot for math.score
boxplot.math.score <- ggplot(data, aes(x=math.score)) +
geom_boxplot(fill='#A4A4A4', color="black") + coord_flip() +
labs(title="Box plot for Math scores",x="Math Scores", y = "")
# boxplot for reading.score
boxplot.reading.score<- ggplot(data, aes(x=reading.score)) +
geom_boxplot(fill='#A4A4A4', color="black") + coord_flip() +
labs(title="Box plot for Reading Scores",x="Reading Scores", y = "")
# boxplot for writing.score
boxplot.writing.score <- ggplot(data, aes(x=writing.score)) +
geom_boxplot(fill='#A4A4A4', color="black") + coord_flip() +
labs(title="Box plot for Writing scores",x="Writing Scores", y = "")
# The three defined plots are going to be plotted on this page
ggarrange(boxplot.writing.score, boxplot.math.score, boxplot.reading.score,
ncol = 3, nrow = 1)
From the above plots, it was seen that there were values which are lower than the lower quartile (whiskey). Even though those values are more than 1.5 IQR below Q1 (Q1 - 1.5 * IQR), they are either exactly zero or above zero, which in our case is the lowest possible score a person can get.
Interpreting the above plots, looking at the values which are in the Interquartile Range (IQR), for all of the subjects most of students’ scores were above 50, which is usually the pass/fail boundary in exams. Therefore, only a small portion of the students were below the pass/fail boundary
Specifically, assuming that the pass/fail boundary is the score of 50, the ratios of passed students for the subjects were calculated. In order to avoid code repetition and increase readability, two functions (check_above_fifty() and get_prop_of_passed_in_subject ()) that were multiple times used were implemented.
# In order to avoid code repetition and increase readability, two functions that were multiple times used were implemented.
# Returns true if the given x is above 50
check_above_fifty <- function(x){
# Check if the given x is integer or numeric, and stop if it is not
stopifnot((class(x) == "integer") || (class(x) == "numeric"))
return (x > 50)
}
# Returns the proportion of the passed students for the given subject
get_prop_of_passed_in_subject <- function(data, subject.score){
# Check if the given data is a data.frame, and stop if it is not
stopifnot(class(data) == "data.frame")
# Check if the given subject.score variable exists as a column in the data.frame data, and stop if it is not
stopifnot(subject.score %in% colnames(data))
# Counting the total students/rows that their scores were above 50 (pass/fail limit)
total_students_passed <- length(Filter(check_above_fifty, data[, subject.score]))
# Returning the proportion of passed students for the given subject
return (total_students_passed/length(data[, subject.score]))
}
# Calculating the pass ratios for the three subjects
pass.math <- get_prop_of_passed_in_subject(data, 'math.score')
pass.reading <-get_prop_of_passed_in_subject(data, 'reading.score')
pass.writing <- get_prop_of_passed_in_subject(data, 'writing.score')
# Saving the values in a data.frame
pass_ratios <- data.frame(subject=c("Maths", "Reading", "Writing"),
pass_rate=c(pass.math, pass.reading, pass.writing ))
# Plotting pass rates with basic ggplot barplot
ggplot(data=pass_ratios, aes(x=subject, y=pass_rate)) +
geom_bar(stat="identity", fill="steelblue") +
geom_text(aes(label=pass_rate), vjust=1.6, color="white", size=5) +
theme_minimal() +
labs(title="Pass rates per subject", x="Subject", y = "Pass rate")
In general, assuming that a score of 50 is the minimum to pass, the passing rates are good. The students which fail mostly fail on the math exams, while the reading subject seems to be the most passed subject.
Next, the densities of the different scores were plotted on top of their histograms. The distribution-density of each score was visualized with a histogram. The bins of the histograms were calculated manually with the use of the Freedman–Diaconis’ rule, which was also discussed in class and is less sensitive to outliers in data. The Freedman–Diaconis’ choice calculates the bin width h as: \[ h=2 \frac{\operatorname{IQR}(x)}{\sqrt[3]{n}} \]
# Histogram with FD method and color by groups for writing scores
breaks.writing.score <- pretty(range(data[,'writing.score']), n = nclass.FD(data[,'writing.score']), min.n = 1)
writing.score.dens.plot <- ggplot(data, aes(x=writing.score)) +
geom_histogram(aes(y=..density..), alpha=0.5, breaks = breaks.writing.score,
position="identity") +
geom_density(alpha=.2) + ggtitle("Distribution of Writing Scores")
# Histogram with FD method and color by groups for math scores
breaks.math.score <- pretty(range(data[,'math.score']), n = nclass.FD(data[,'math.score']), min.n = 1)
math.score.dens.plot <- ggplot(data, aes(x=math.score)) +
geom_histogram(aes(y=..density..), alpha=0.5, breaks = breaks.math.score,
position="identity") +
geom_density(alpha=.2) + ggtitle("Distribution of Math Scores")
# Histogram with FD method and color by groups for reading scores
breaks.reading.score <- pretty(range(data[,'reading.score']), n = nclass.FD(data[,'reading.score']), min.n = 1)
reading.score.dens.plot <- ggplot(data, aes(x=reading.score)) +
geom_histogram(aes(y=..density..), alpha=0.5, breaks = breaks.reading.score,
position="identity") +
geom_density(alpha=.2) + ggtitle("Distribution of Reading Scores")
# The three defined plots are going to be plotted on this page
ggarrange(math.score.dens.plot, reading.score.dens.plot, writing.score.dens.plot,
ncol = 3, nrow = 1)
As illustrated, the histogram of math scores has an empty gap on its left side, which indicates the low score outliers that were also observed in the boxplots. Even though all of the score variables follow a bell shaped distribution, both their boxplots and plotted densities looked a little bit negatively skewed.
The script below calculate the skewness of the samples.
# The sample skewness for writing.score
skewness(data$writing.score)
## [1] -0.2890096
# The sample skewness for math.score
skewness(data$math.score)
## [1] -0.2785166
# The sample skewness for reading.score
skewness(data$reading.score)
## [1] -0.2587157
Indeed all the score variables were not exactly symmetric, since their skewnewss indicated that the distributions were a little negatively skewed.
Since the distributions are not exactly symmetric but follow a bell shaped distribution, it was not easily distinguishable whether the distributions follow the Normal-Gaussian distribution or not. Thus, it was furthered checked if the scores follow the Normal-Gaussian distribution with more visualization and hypothesis testing.
The variables were first standardized in order to have zero mean and standard deviation of one, in order to compare their densities with the density of the Standard Normal distribution. The Probability Density function (PDF) of the data was estimated, by utilizing the default Gaussian Kernel Density Estimation which computes kernel density estimates.
# Arranging 3 figures in 1 rows and 3 columns
par(mfrow=c(1,3))
# Density Estimation(Mi parametriki ektimisi spp kanonikopoiimenou deigmatos)
# Density estimation of scaled Math Score
std.ms<-scale(data$math.score)
dens.std <- density(std.ms)
x.data <- dens.std$x
plot(dens.std, main="Density estimation of scaled Math Score", ylim=c(0,0.5))
lines(x.data,dnorm(x.data), col="red")
legend("topleft",legend=c("Standardised data", "Standard Normal"),
col=c("black", "red"), lty=1, cex=1.25)
# Density estimation of scaled Reading Score
std.rs<-scale(data$reading.score)
dens.std <- density(std.rs)
x.data <- dens.std$x
plot(dens.std, main="Density estimation of scaled Reading Score", ylim=c(0,0.5))
lines(x.data,dnorm(x.data), col="red")
legend("topleft",legend=c("Standardised data", "Standard Normal"),
col=c("black", "red"), lty=1, cex=1.25)
# Density estimation of scaled Writing Score
std.ws<-scale(data$writing.score)
dens.std <- density(std.ws)
x.data <- dens.std$x
plot(dens.std, main="Density estimation of scaled Writing Score", ylim=c(0,0.5))
lines(x.data,dnorm(x.data), col="red")
legend("topleft",legend=c("Standardised data", "Standard Normal"),
col=c("black", "red"), lty=1, cex=1.25)
The estimated PDF of the math score looks very similar with the PDF of the Standard Normal, while the other two are questionable. On that account, a Quantile-Quantile plot (QQ plot) and the non-parametric Kolmogorov-Smirnov test were employed, in order to test for normality of the distributions.
# Arranging 3 figures in 1 rows and 3 columns
par(mfrow=c(1,3))
# QQ-plots for the different score variables
# For each different score, first standardize the scores (scale and center)
# and compare with Normal Distribution by using a qqtest and run a Kolmogorov-Smirnov test afterwards to compare with the Normal Distribution
qqnorm(std.ms,main='Normal QQ-plot of standardised Maths Score',col='deepskyblue4')
qqline(std.ms,col='red')
qqnorm(std.rs,main='Normal QQ-plot of standardised Reading Score',col='deepskyblue4')
qqline(std.rs,col='red')
qqnorm(std.ws,main='Normal QQ-plot of standardised Writing Score', col='deepskyblue4')
qqline(std.ws,col='red')
# Kolmogorov-Smirnov tests
ks.test(std.ms,'pnorm')
## Warning in ks.test(std.ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.ms
## D = 0.030855, p-value = 0.297
## alternative hypothesis: two-sided
ks.test(std.rs,'pnorm')
## Warning in ks.test(std.rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.rs
## D = 0.043874, p-value = 0.04257
## alternative hypothesis: two-sided
ks.test(std.ws,'pnorm')
## Warning in ks.test(std.ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.ws
## D = 0.041582, p-value = 0.06297
## alternative hypothesis: two-sided
The null hypothesis of the tests were that the specified score variable follows the Normal distribution (no deviation from normality).
The p-values for the math score (0.297) and writing (0.06297) are larger than 0.05 (5% level of significance), therefore it was concluded that the distribution of math and writing scores were not significantly different from Normal distribution.
Regarding the scores for reading, the p-value was 0.04257 which is lower than 0.05 (5% level of significance), thus the null-hypothesis that the reading scores follow the Normal distribution was rejected.
Next the mean and median were compared for the different scores.
math_stats <- data.frame(subject=c('Maths', 'Maths'), metric=c('median','mean'),
metric_value=c(median(data$math.score), mean(data$math.score)))
reading_stats <- data.frame(subject=c('Reading', 'Reading'), metric=c('median','mean'),
metric_value=c(median(data$reading.score), mean(data$reading.score)))
writing_stats <- data.frame(subject=c('Writing', 'Writing'), metric=c('median','mean'),
metric_value=c(median(data$writing.score), mean(data$writing.score)))
# Bind the two data frames by row and keep the columns (function of dplyr)
subject_stats <- bind_rows(math_stats, reading_stats, writing_stats)
# Using "position=position_dodge()" in order to have three different bars per metric
ggplot(data=subject_stats, aes(x=subject, fill=metric, y=metric_value)) +
geom_bar(stat="identity", position=position_dodge()) +
guides(fill = guide_legend(title = "Metric")) +
geom_text(aes(label=round(metric_value, digits = 2)), color="black", size=5, position=position_dodge(width = .9)) +
labs(title="Mean and median writing score per subject", x="Subject", y = "score")
The lowest median and mean scores are for maths, while the highest are for reading. That further shows that maths is the subject that most students have a hard time to deal with, while students perform better in reading.
During this part of the analysis, differences between the population of males and females were explored.
Following, the distribution of the two genders is presented
# Cast the gender column from the data in a table-format to get the counts of each gender group
gender_count <- table(data$gender)
# Define gender columns
genders <- names(gender_count)
# Pie chart for the gender distribution (In order to show the percentage)
pie_data <- as.data.frame(round(gender_count/sum(gender_count)*100, digits=2)) # First cast the table to a new Data Frame with the percentages
ggplot(data=pie_data, aes(x = "", y = Freq, fill = Var1)) +
geom_col() +
geom_text(aes(label = paste("", gender_count,"\n", Freq, "%")),
position = position_stack(vjust = 0.5),
show.legend = FALSE) + coord_polar(theta = "y") +
guides(fill = guide_legend(title = "Gender")) +
theme( axis.title.x = element_blank(), axis.title.y = element_blank())
The frequencies of the genders in the dataset is not exactly balanced, since the females are slightly more than the males (518 to 482). This will be taken into account for the rest of the analysis.
Following, the distribution of the different categorical variables by gender are illustrated by utilizing the barplot of the ggplot package.
# Stacked barplot with multiple groups for the race.ethnicity
# Using "position=position_dodge()" in order to have two different bars per group
race.ethnicity.plt <- ggplot(data=data, aes(x=race.ethnicity, fill=gender)) +
geom_bar(stat="count", position=position_dodge()) +
guides(fill = guide_legend(title = "Gender")) +
labs(title="Distribution of Ethnicities", x="race ethinicity", y = "")
# Stacked barplot with multiple groups for the parental.level.of.education
# Using "position=position_dodge()" in order to have two different bars per group
parental.level.of.education.plt <- ggplot(data=data, aes(x=parental.level.of.education, fill=gender)) +
geom_bar(stat="count", position=position_dodge()) +
guides(fill = guide_legend(title = "Gender")) +
labs(title="Distribution of Different PLE", x="parental level of education", y = "")
# Stacked barplot with multiple groups for the test.preparation.course.plt
# Using "position=position_dodge()" in order to have two different bars per group
test.preparation.course.plt <- ggplot(data=data, aes(x=test.preparation.course, fill=gender)) +
geom_bar(stat="count", position=position_dodge()) +
guides(fill = guide_legend(title = "Gender")) +
labs(title="Distribution of Test Preparation Course",x="Test preperation course", y = "")
# Stacked barplot with multiple groups for the lunch.plt
# Using "position=position_dodge()" in order to have two different bars per group
lunch.plt <- ggplot(data=data, aes(x=lunch, fill=gender)) +
geom_bar(stat="count", position=position_dodge()) +
guides(fill = guide_legend(title = "Gender")) +
labs(title="Distribution of Lunch",x="Lunch", y = "")
# The three defined plots are going to be plotted on this page
ggarrange(race.ethnicity.plt, parental.level.of.education.plt,
test.preparation.course.plt, lunch.plt,
ncol = 2, nrow = 2)
It can be seen that some ethnicities have more male students than females (groups A, D and E), and vice-versa (groups D, C). Also, it was mentioned that the population of males and females is not exactly balanced, thus it is not safe to draw many conclusions from the above plots.
One solution for the above mentioned issue was to plot proportions instead of the frequencies by re-scaling.
Regarding which of the who populations takes the test preparation course more, the relative proportions were plotted
data %>% count(gender, test.preparation.course) %>% group_by(gender) %>%
mutate(prop = n / sum(n)) %>%
ggplot(mapping = aes(x = gender, y = test.preparation.course)) +
geom_tile(mapping = aes(fill = prop)) +
geom_text(aes(label=round(prop, digits=3)), color="white")
As it can be observed, the difference is very little between the two groups. The proportion of males which completed the test is a little bit higher compared to the females (0.361 to 0.355).
Regarding which of the who populations takes the standard lunch more, the relative proportions were plotted
data %>% count(gender, lunch) %>% group_by(gender) %>%
mutate(prop = n / sum(n)) %>%
ggplot(mapping = aes(x = gender, y = lunch)) +
geom_tile(mapping = aes(fill = prop)) +
geom_text(aes(label=round(prop, digits=3)), color="white")
Again, the difference is only little between the two groups. The proportion of females which have reduced lunch is a little bit higher compared to the males (0.365 to 0.344).
Succeeding, boxplots for the different score variables, were plotted gender wise. Additionally, the distribution-density of each score was visualized with a histogram. The bins of the histograms were calculated manually with the use of the Freedman–Diaconis’ metric.
# boxplot for math.score
# Using "position=position_dodge()" in order to have a different boxplot per gender
boxplot.gender.math.score <- ggplot(data=data, aes(x=math.score, y=gender, fill=gender)) +
geom_boxplot() + coord_flip() +
labs(title="Box plot for Math Scores",x="Math Scores", y = "Gender")
# boxplot for reading.score
# Using "position=position_dodge()" in order to have a different boxplot per gender
boxplot.gender.reading.score<- ggplot(data=data, aes(x=reading.score, y=gender, fill=gender)) +
geom_boxplot() + coord_flip() +
labs(title="Box plot for Reading Scores",x="Reading Scores", y = "Gender")
# boxplot for writing.score
# Using "position=position_dodge()" in order to have a different boxplot per gender
boxplot.gender.writing.score <- ggplot(data=data, aes(x=writing.score, y=gender, fill=gender)) +
geom_boxplot() + coord_flip() +
labs(title="Box plot for Writing Scores",x="Writing Scores", y = "Gender")
# The three defined plots are going to be plotted on this page
ggarrange(boxplot.gender.math.score, boxplot.gender.reading.score, boxplot.gender.writing.score,
ncol = 3, nrow = 1)
# Histogram with Freedman–Diaconis method and color by groups for writing scores
breaks.writing.score <- pretty(range(data[,'writing.score']), n = nclass.FD(data[,'writing.score']), min.n = 1)
writing.score.dens.plot <- ggplot(data, aes(x=writing.score, color=gender, fill=gender)) +
geom_histogram(aes(y=..density..), alpha=0.5, breaks = breaks.writing.score,
position="identity") +
geom_density(alpha=.2) + ggtitle("Distribution of Writing Scores")
# Histogram with Freedman–Diaconis method and color by groups for math scores
breaks.math.score <- pretty(range(data[,'math.score']), n = nclass.FD(data[,'math.score']), min.n = 1)
math.score.dens.plot <- ggplot(data, aes(x=math.score, color=gender, fill=gender)) +
geom_histogram(aes(y=..density..), alpha=0.5, breaks = breaks.math.score,
position="identity") +
geom_density(alpha=.2) + ggtitle("Distribution of Math Scores")
# Histogram with Freedman–Diaconis method and color by groups for reading scores
breaks.reading.score <- pretty(range(data[,'reading.score']), n = nclass.FD(data[,'reading.score']), min.n = 1)
reading.score.dens.plot <- ggplot(data, aes(x=reading.score, color=gender, fill=gender)) +
geom_histogram(aes(y=..density..), alpha=0.5, breaks = breaks.reading.score,
position="identity") +
geom_density(alpha=.2) + ggtitle("Distribution of Reading Scores")
# The three defined plots are going to be plotted on this page
ggarrange(math.score.dens.plot, reading.score.dens.plot, writing.score.dens.plot,
ncol = 3, nrow = 1)
Firstly, an interesting point, is that the median and interquantile ranges (IQR) of the populations for the different scores, revealed that the females are more likely to perform better on the writing and reading exams, while the males performed better for the math exams. Those observations were then checked and confirmed with hypothesis testing. Moreover, what can be seen is that even though females performed better on writing and reading, the outliers which are more than 1.5 IQR below Q1 in the female population, are more in total compared to the males.
In order to compare the scores of the two individual populations (males and females) it was decided to utilize a two sample t-test hypothesis testing. As literature suggests, t-test assumes normality in the data. During the Analysis of the scoring variables section, it was shown that only the math and writing scores were normally distributed. The scoring variables of the two individual populations (males and females) were furthered tested for their normality in order to employ the t-test and accurately compare the means of the two groups.
A Quantile-Quantile plot (QQ plot) and the non-parametric Kolmogorov-Smirnov test were employed, in order to test for normality of the distribution for the different scores of the males
# QQ-plots of Males' Performance:
par(mfrow=c(1,3))
# For each different score of the males, first standardize the scores (scale and center)
# and compare with Normal Distribution by using a qqtest and run a Kolmogorov-Smirnov test afterwards to compare with the Normal Distribution
std.males_ms<-scale(data$math.score[data$gender=='male'])
qqnorm(std.males_ms,main='Normal QQ-plot of standardised Maths Score of Males',col='deepskyblue4')
qqline(std.males_ms,col='red')
std.males_rs<-scale(data$reading.score[data$gender=='male'])
qqnorm(std.males_rs,main='Normal QQ-plot of standardised Reading Score of Males',col='deepskyblue4')
qqline(std.males_rs,col='red')
std.males_ws<-scale(data$writing.score[data$gender=='male'])
qqnorm(std.males_ws,main='Normal QQ-plot of standardised Writing Score of Males', col='deepskyblue4')
qqline(std.males_ws,col='red')
# Run the non-parametric Kolmogorov-Smirnov test to compare with the Normal Distribution
ks.test(std.males_ms,'pnorm')
## Warning in ks.test(std.males_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.males_ms
## D = 0.038781, p-value = 0.4632
## alternative hypothesis: two-sided
ks.test(std.males_ws,'pnorm')
## Warning in ks.test(std.males_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.males_ws
## D = 0.03989, p-value = 0.4271
## alternative hypothesis: two-sided
ks.test(std.males_rs,'pnorm')
## Warning in ks.test(std.males_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.males_rs
## D = 0.045744, p-value = 0.2654
## alternative hypothesis: two-sided
The null hypothesis of the tests were that the a specified score variable (for the males only) follows the Normal distribution.
Regarding the male group, the p-values for the math score (0.4632), writing (0.4271) and reading (0.2654) are a lot larger than 0.05 (5% level of significance), therefore it was concluded that the distributions of the different scores for the males were not significantly different from Normal distribution.
A Quantile-Quantile plot (QQ plot) and the non-parametric Kolmogorov-Smirnov test were employed, in order to test for normality of the distribution for the different scores of the females.
# QQ-plots of Females' Performance:
par(mfrow=c(1,3))
# For each different score of the females, first standardize the scores (scale and center)
# and compare with Normal Distribution by using a qqtest and run a Kolmogorov-Smirnov test afterwards to compare with the Normal Distribution
std.females_ms<-scale(data$math.score[data$gender=='female'])
qqnorm(std.females_ms,main='Normal QQ-plot of standardised Maths Score of Females',col='deepskyblue4')
qqline(std.females_ms,col='red')
std.females_rs<-scale(data$reading.score[data$gender=='female'])
qqnorm(std.females_rs,main='Normal QQ-plot of standardised Reading Score of Females',col='deepskyblue4')
qqline(std.females_rs,col='red')
std.females_ws<-scale(data$writing.score[data$gender=='female'])
qqnorm(std.females_ws,main='Normal QQ-plot of standardised Writing Score of Females', col='deepskyblue4')
qqline(std.females_ws,col='red')
# Run the non-parametric Kolmogorov-Smirnov test to compare with the Normal Distribution
ks.test(std.females_ms,'pnorm')
## Warning in ks.test(std.females_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.females_ms
## D = 0.043394, p-value = 0.2835
## alternative hypothesis: two-sided
ks.test(std.females_ws,'pnorm')
## Warning in ks.test(std.females_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.females_ws
## D = 0.061414, p-value = 0.04018
## alternative hypothesis: two-sided
ks.test(std.females_rs,'pnorm')
## Warning in ks.test(std.females_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.females_rs
## D = 0.046839, p-value = 0.2058
## alternative hypothesis: two-sided
The null hypothesis of the tests were that the a specified score variable (for the females only) follows the Normal distribution.
Regarding the female group, the p-values for the math score (0.2835) and reading (0.2058) are larger than 0.05 (5% level of significance), therefore it was concluded that the distribution of math and reading scores were not significantly different from Normal distribution.
Regarding the scores for writing, the p-value was 0.04018 which is lower than 0.05 (5% level of significance), thus the null-hypothesis that the writing scores follow the Normal distribution was rejected.
Therefore since for both of the individual populations, normality exists only for math and reading scores, the t-tests were employed only for those two scores.
Eventually, a two sample t-test hypothesis testing had been performed in order to see if there is significant difference in the means of the two different populations (males and females) for the scores in the two subjects. There are more types of t-tests, but in this case a two-sample t-test was utilized since we were interested in groups that come from two different groups.
Since more t-tests were employed during the process of this analysis, and in order to avoid code repetition and increase readability, a function that runs the whole procedure dynamically has been implemented. Specifically, the implemented function compare.populations() divides the data samples in to two populations, prints the mean, variance, standard deviation of the two samples and finally runs a two sample t-test.
# Function that dynamically divides the data samples of the given dataframe data.df in to two populations based on group.variable. Prints summary statistics of the two samples for the variable.to.observe column and finally runs a two sample t-test
compare.populations <- function(data.df, group.variable, variable.to.observe){
# Check conditions for the input of the data
stopifnot(class(group.variable) == "character")
stopifnot(class(variable.to.observe) == "character")
stopifnot(class(data) == "data.frame")
groups <- levels(data.df[[group.variable]])
# Check that groups is a vector of size two
stopifnot(class(groups) == "character")
stopifnot(length(groups) == 2)
# Create an empty list which the vectors of the data
# are going to be added
groups.data <- list()
# Divide data samples in to two populations dynamically
for (group in groups){
group.data <- filter(data.df, data.df[[group.variable]] == group)
groups.data[[length(groups.data)+1]] <- group.data
}
# Comparing the Measure of variability between both samples
i <- 1
for (group.data in groups.data){
cat("Mean of group", groups[i], mean(group.data[[variable.to.observe]]), "\n")
cat("Variance of group", groups[i], var(group.data[[variable.to.observe]]), "\n")
cat("Standard Deviation of group", groups[i], sd(group.data[[variable.to.observe]]), "\n", "\n")
i <- i + 1
}
# Two-sample t-test
t.test(data.df[[variable.to.observe]] ~ data.df[[group.variable]], data = data)
}
The following two sample t-test for the reading score:
Variable to split population: gender
Hypotheses:
Significant level: 0.05 (95 percent confidence interval)
# TWO SAMPLE T-TEST
# VARIABLE: GENDER
# Hypotheses for reading score:
# H0: There is no difference between the average reading score of male and female students
# H1: There is a difference between the average reading score of male and female students
# Significant level 0.05
compare.populations(data, 'gender', 'reading.score')
## Mean of group female 72.60811
## Variance of group female 206.7339
## Standard Deviation of group female 14.37825
##
## Mean of group male 65.47303
## Variance of group male 194.0959
## Standard Deviation of group male 13.93183
##
##
## Welch Two Sample t-test
##
## data: data.df[[variable.to.observe]] by data.df[[group.variable]]
## t = 7.9684, df = 996.36, p-value = 4.376e-15
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 5.377941 8.892218
## sample estimates:
## mean in group female mean in group male
## 72.60811 65.47303
Interpreting the outcome of the t-test, the difference in reading score between females (Mean = 72.6; SD = 14.37) and males (Mean = 65.47; SD = 13.93) was significant (t-value = 7.968) with p < 4.376e-15.
Next, the following two sample t-test for the math score:
The following two sample t-test:
Variable to split population: gender
Hypotheses:
Significant level: 0.05 (95 percent confidence interval)
# TWO SAMPLE T-TEST
# VARIABLE: GENDER
# Hypotheses for math score:
# H0: There is no difference between the average math score of male and female students
# H1: There is a difference between the average math score of male and female students
# Significant level 0.05
compare.populations(data, 'gender', 'math.score')
## Mean of group female 63.6332
## Variance of group female 239.9851
## Standard Deviation of group female 15.49145
##
## Mean of group male 68.72822
## Variance of group male 206.1027
## Standard Deviation of group male 14.35628
##
##
## Welch Two Sample t-test
##
## data: data.df[[variable.to.observe]] by data.df[[group.variable]]
## t = -5.398, df = 997.98, p-value = 8.421e-08
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -6.947209 -3.242813
## sample estimates:
## mean in group female mean in group male
## 63.63320 68.72822
Interpreting the outcome of the t-test, the difference in math.score between females (Mean = 63.63; SD = 15.49) and males (Mean = 68.73; SD = 14.36) was significant (t-value = -5.398; p < 8.421e-08).
Lastly, since the writing scores are not normally distributed for the female group, the subject’s scores were compared by the mean and median.
# Isolating the writing scores of the two populations
female.writing.score <- filter(data, data$gender == 'female')[, 'writing.score']
male.writing.score <- filter(data, data$gender == 'male')[, 'writing.score']
# Constructing data.frames for the median and mean of the two groups
female_writing_stats <- data.frame(gender=c('female', 'female'), metric=c('median','mean'),
metric_value=c(median(female.writing.score), mean(female.writing.score)))
male_writing_stats <- data.frame(gender=c('male', 'male'), metric=c('median','mean'),
metric_value=c(median(male.writing.score), mean(male.writing.score)))
# Bind the two data frames by row and keep the columns (function of dplyr)
writing_stats <- bind_rows(female_writing_stats, male_writing_stats)
# Stacked barplot with multiple groups for the means and medians
# Using "position=position_dodge()" in order to have two different bars per group
ggplot(data=writing_stats, aes(x=metric, fill=gender, y=metric_value)) +
geom_bar(stat="identity", position=position_dodge()) +
guides(fill = guide_legend(title = "Gender")) +
geom_text(aes(label=round(metric_value, digits = 2)), color="black", size=5, position=position_dodge(width = .9)) +
labs(title="Mean and median writing score per gender", x="metric", y = "score")
As it was shown, both mean and median writing score of the female group were higher than the male group.
In conclusion, after running the two hypothesis testings, it was proven that it is statistically significant with 95% confidence interval, that generally the females outperformed the males in reading, while the males performed better in maths. Finally, by looking at the distributions, box plots and the summary statistics for the writing score, it seems like the females outperform the males for that subject.
From the summary of variables, it was already known that the group samples population across the test preparation is unequal(none=642, completed=358). However, this was something that it has taken into account while analyzing the findings on the influence of test preparation on subjects scores.
To see if test preparation affects the subject results, a two-sample Welch’s t-test was used to compare the means of the two individual populations (none, completed). The Welch’s t-test assumes normality from the distribution for the different scores of the none and completes course populations, hence the non-parametric Kolmogorov-Smirnov test was used to test for normality.
### VARIABLE: TEST PREPARATION COURSE
# CHECK FOR NORMALITY reading
std.none_rs<-scale(data$reading.score[data$test.preparation.course=="none"])
std.completed_rs<-scale(data$reading.score[data$test.preparation.course=='completed'])
ks.test(std.none_rs,'pnorm')
## Warning in ks.test(std.none_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.none_rs
## D = 0.038209, p-value = 0.3058
## alternative hypothesis: two-sided
ks.test(std.completed_rs,'pnorm')
## Warning in ks.test(std.completed_rs, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.completed_rs
## D = 0.064557, p-value = 0.1012
## alternative hypothesis: two-sided
# CHECK FOR NORMALITY WRITING
std.none_ws<-scale(data$writing.score[data$test.preparation.course=="none"])
std.completed_ws<-scale(data$writing.score[data$test.preparation.course=='completed'])
ks.test(std.none_ws,'pnorm')
## Warning in ks.test(std.none_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.none_ws
## D = 0.036468, p-value = 0.3605
## alternative hypothesis: two-sided
ks.test(std.completed_ws,'pnorm')
## Warning in ks.test(std.completed_ws, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.completed_ws
## D = 0.05822, p-value = 0.1765
## alternative hypothesis: two-sided
# CHECK FOR NORMALITY MATH
std.none_ms<-scale(data$math.score[data$test.preparation.course=="none"])
std.completed_ms<-scale(data$math.score[data$test.preparation.course=='completed'])
ks.test(std.none_ms,'pnorm')
## Warning in ks.test(std.none_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.none_ms
## D = 0.036549, p-value = 0.3578
## alternative hypothesis: two-sided
ks.test(std.completed_ms,'pnorm')
## Warning in ks.test(std.completed_ms, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.completed_ms
## D = 0.028989, p-value = 0.9243
## alternative hypothesis: two-sided
As a result of the non-parametric Kolmogorov-Smirnov test with a 95 percent confidence interval, we may infer that the various scores of none and completed course populations do not violate the Welch’s t-test normality assumption, since all P-values are greater than 0.05.
We were able to continue with the hypothesis testing and infer if the test preparation did really influence the students’ results, since the Welch’s t-test took into account that the variance across the two individual populations might not the same.
The following two sample Welch’s-test was conducted for the writing score variable between the two different populations (none and completes) test preparation.
# TWO SAMPLE T-TEST
#->Variables to Observe: WRITING SCORE - COURSE PREP
#->Hypotheses:
#H0: There is no difference between the average writing score on preparation and none preparation course .
#H1: There is a difference between the average writing score on preparation and none preparation course .
#->Significant level 0.05
#two-sample t-test
t.test(writing.score ~ test.preparation.course, data = data)
##
## Welch Two Sample t-test
##
## data: writing.score by test.preparation.course
## t = 10.753, df = 811.13, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 8.104442 11.724201
## sample estimates:
## mean in group completed mean in group none
## 74.41899 64.50467
## p-value < 0.05 -> accept H1 so, significant difference between average writing score of completed and none completed prep course)
The result of the hypothesis testing reveal that indeed there is a significant difference between the mean writing score on none and completed test preparation course, since the P-value(2.2e-16) of the test was less than 0.05, the null hypothesis is rejected.
The following two sample Welch’s-test was conducted for the reading score variable between the two different populations (none and completes) test preparation.
# TWO SAMPLE T-TEST
#->Variables to Observe: READING SCORE - COURSE PREP
#->Hypotheses:
#H0: There is no difference between the average reading score on preparation and none preparation course .
#H1: There is a difference between the average reading score on preparation and none preparation course .
#->Significant level 0.05
#two-sample t-test
t.test(reading.score ~ test.preparation.course, data = data)
##
## Welch Two Sample t-test
##
## data: reading.score by test.preparation.course
## t = 8.0041, df = 775.37, p-value = 4.389e-15
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 5.554635 9.164539
## sample estimates:
## mean in group completed mean in group none
## 73.89385 66.53427
## p-value < 0.05 -> accept H1 so, significant difference between average reading score of completed and none completed prep course)
The following two sample Welch’s-test was conducted for the maths score variable between the two different populations (none and completes) test preparation.
The result of the hypothesis testing reveal that indeed there is a significant difference between the mean reading score on none and completed test preparation course, since the P-value(4.389e-15) of the test was less than 0.05, and the null hypothesis was rejected.
# TWO SAMPLE T-TEST
#->Variables to Observe: MATH SCORE - COURSE PREP
#->Hypotheses:
#H0: There is no difference between the average math score on preparation and none preparation course .
#H1: There is a difference between the average math score on preparation and none preparation course .
#->Significant level 0.05
#two-sample t-test
t.test(math.score ~ test.preparation.course, data = data)
##
## Welch Two Sample t-test
##
## data: math.score by test.preparation.course
## t = 5.787, df = 770.08, p-value = 1.043e-08
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## 3.712041 7.523257
## sample estimates:
## mean in group completed mean in group none
## 69.69553 64.07788
## p-value < 0.05 -> accept H1 so, significant difference between average math score of completed and none completed prep course)
The result of the hypothesis testing reveal that indeed there is a significant difference between the mean math score on none and completed test preparation course, since the P-value(1.043e-08) of the test was less than 0.05, the null hypothesis was rejected.
To conclude, students who had completed a course preparation test appear to score better in all subjects than those who did not have any preparation test.
From the summary of variables, it was already known that the group samples population across the lunch was unequal (free/reduced=355, standard=645). However, this was something which had been taken into account while analysing our findings on the influence of lunch on subjects scores.
To obsrve if lunch affects the subject results, a two-sample Welch’s t-test was used to compare the means of the two individual populations (free/reduced, standard). The Welch’s t-test assumes normality from the distribution for the different scores of the none and completes course populations, hence the non-parametric Kolmogorov-Smirnov test was used to test for normality.
### VARIABLE:LUNCH
#CHECK FOR NORMALITY reading
std.freereduced_rs<-scale(data$reading.score[data$lunch=="free/reduced"])
std.standard_rs<-scale(data$reading.score[data$lunch=='standard'])
ks.test(std.freereduced_rs,'pnorm')
## Warning in ks.test(std.freereduced_rs, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.freereduced_rs
## D = 0.044016, p-value = 0.4973
## alternative hypothesis: two-sided
ks.test(std.standard_rs,'pnorm')
## Warning in ks.test(std.standard_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.standard_rs
## D = 0.041755, p-value = 0.2108
## alternative hypothesis: two-sided
#CHECK FOR NORMALITY WRITING
std.freereduced_ws<-scale(data$writing.score[data$lunch=="free/reduced"])
std.standard_ws<-scale(data$writing.score[data$lunch=='standard'])
ks.test(std.freereduced_ws,'pnorm')
## Warning in ks.test(std.freereduced_ws, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.freereduced_ws
## D = 0.0351, p-value = 0.7742
## alternative hypothesis: two-sided
ks.test(std.standard_ws,'pnorm')
## Warning in ks.test(std.standard_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.standard_ws
## D = 0.047592, p-value = 0.1076
## alternative hypothesis: two-sided
#CHECK FOR NORMALITY MATH
std.freereduced_ms<-scale(data$math.score[data$lunch=="free/reduced"])
std.standard_ms<-scale(data$math.score[data$lunch=='standard'])
ks.test(std.freereduced_ms,'pnorm')
## Warning in ks.test(std.freereduced_ms, "pnorm"): ties should not be present for
## the Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.freereduced_ms
## D = 0.04186, p-value = 0.5626
## alternative hypothesis: two-sided
ks.test(std.standard_ms,'pnorm')
## Warning in ks.test(std.standard_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.standard_ms
## D = 0.032395, p-value = 0.5076
## alternative hypothesis: two-sided
As a result of the non-parametric Kolmogorov-Smirnov test with a 95 percent confidence interval, we may infer that the various scores of free/reduce and standard populations do not violate the Welch’s t-test normality assumption, since all P-values are greater than 0.05.
We were able to continue with the hypothesis testing and infer if the lunch did really influence the students’ results, since the Welch’s t-test took into account that the variance across the two individual populations might not the same.
The following two sample Welch’s-test was conducted for the different score variables between the two different populations (free/reduce and standard) lunch.
# TWO SAMPLE T-TEST
#->Variables to Observe: WRITING SCORE/READING/MATH- LUNCH
#->Hypotheses:
#H0: There is no difference between the average writing score on standard and free lunch .
#H1: There is a difference between the average writing score on standard and free lunch .
#->Significant level 0.05
#two-sample t-test
t.test(writing.score ~ lunch, data = data)
##
## Welch Two Sample t-test
##
## data: writing.score by lunch
## t = -7.8409, df = 685.25, p-value = 1.716e-14
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -9.754100 -5.847342
## sample estimates:
## mean in group free/reduced mean in group standard
## 63.02254 70.82326
## p-value < 0.05 -> accept H1 so, significant difference between averages of standard and free/reduced lunch)
#two-sample t-test
t.test(reading.score ~ lunch, data = data)
##
## Welch Two Sample t-test
##
## data: reading.score by lunch
## t = -7.2926, df = 684.9, p-value = 8.422e-13
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -8.885594 -5.115891
## sample estimates:
## mean in group free/reduced mean in group standard
## 64.65352 71.65426
## p-value < 0.05 -> accept H1 so, significant difference between averages of standard and free/reduced lunch)
#two-sample t-test
t.test(math.score ~ lunch, data = data)
##
## Welch Two Sample t-test
##
## data: math.score by lunch
## t = -11.484, df = 667.5, p-value < 2.2e-16
## alternative hypothesis: true difference in means is not equal to 0
## 95 percent confidence interval:
## -13.01305 -9.21291
## sample estimates:
## mean in group free/reduced mean in group standard
## 58.92113 70.03411
## p-value < 0.05 -> accept H1 so, significant difference between averages of standard and free/reduced lunch)
Regarding the reading score, the result of the hypothesis testing reveal that indeed lunch has a significant difference in mean reading score between free/reduce and standard population, since the P-value(8.422e-13) of the test was less than 0.05, and the null hypothesis was rejected.
For the writing score, the result of the hypothesis testing reveal that indeed lunch has a significant difference in mean writing score between free/reduce and standard population, since the P-value(1.716e-14) of the test was less than 0.05, the null hypothesis has been rejected.
Finally, for the math score, the result of the hypothesis testing revealed that indeed there is a significant difference between the mean writing score on free/reduce and standard, since the P-value(2.2e-16) of the test was less than 0.05 and the null hypothesis was rejected.
From the initial summary of variables, it was already known that the group samples population across the race ethnicity is unequal. However, this was something we took into account while analysing the different findings on the influence of racial ethnicity on subject score.
Boxplots for the scores based on the different race/ethnicity
# boxplot for math.score
# Using "position=position_dodge()" in order to have a different boxplot per group
boxplot.gender.math.score <- ggplot(data=data, aes(x=math.score, y=race.ethnicity, fill=race.ethnicity)) +
geom_boxplot() + coord_flip() +
labs(title="Box plot for Math Scores",x="Math Scores", y = "Ethinicity")
# boxplot for reading.score
# Using "position=position_dodge()" in order to have a different boxplot per group
boxplot.gender.reading.score<- ggplot(data=data, aes(x=reading.score, y=race.ethnicity, fill=race.ethnicity)) +
geom_boxplot() + coord_flip() +
labs(title="Box plot for Reading Scores",x="Reading Scores", y = "Ethinicity")
# boxplot for writing.score
# Using "position=position_dodge()" in order to have a different boxplot per group
boxplot.gender.writing.score <- ggplot(data=data, aes(x=writing.score, y=race.ethnicity, fill=race.ethnicity)) +
geom_boxplot() + coord_flip() +
labs(title="Box plot for Writing Scores",x="Writing Scores", y = "Ethinicity")
# The three defined plots are going to be plotted on this page
ggarrange(boxplot.gender.math.score, boxplot.gender.reading.score, boxplot.gender.writing.score,
ncol = 3, nrow = 1)
It discovered that for all the topics, race ethnicity under group E had the highest performance, although group A did not do as well as the other ethnicities. One thing to keep in mind is that the order of greater performance in all subjects is almost the same. However, in order to compare the means of each race ethnicity population and be more exact about our conclusions, it was chosen to cross-check these results using an ANOVA test (analysis of variance).
During the analysis, it was determined if race/ethnicity had an impact on subject scores or not by using an ANOVA test. However, ANOVA assumes normality in the data , so it was investigated how the different ethnicity groups’ populations are distributed in order to establish the tests and conclude if ethnicity has an influence on subject scores.
To assess the normality of the distribution for the different scores of each race ethnicity population, the non-parametric Kolmogorov-Smirnov test was used.
### VARIABLE: RACE ETHNICITY
#CHECK FOR NORMALITY READIND SCORE
std.groupA_rs<-scale(data$reading.score[data$race.ethnicity=='group A'])
std.groupB_rs<-scale(data$reading.score[data$race.ethnicity=='group B'])
std.groupC_rs<-scale(data$reading.score[data$race.ethnicity=='group C'])
std.groupD_rs<-scale(data$reading.score[data$race.ethnicity=='group D'])
std.groupE_rs<-scale(data$reading.score[data$race.ethnicity=='group E'])
ks.test(std.groupA_rs,'pnorm')
## Warning in ks.test(std.groupA_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupA_rs
## D = 0.047275, p-value = 0.9886
## alternative hypothesis: two-sided
ks.test(std.groupB_rs,'pnorm')
## Warning in ks.test(std.groupB_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupB_rs
## D = 0.057828, p-value = 0.5489
## alternative hypothesis: two-sided
ks.test(std.groupC_rs,'pnorm')
## Warning in ks.test(std.groupC_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupC_rs
## D = 0.071, p-value = 0.08021
## alternative hypothesis: two-sided
ks.test(std.groupD_rs,'pnorm')
## Warning in ks.test(std.groupD_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupD_rs
## D = 0.044925, p-value = 0.6657
## alternative hypothesis: two-sided
ks.test(std.groupE_rs,'pnorm')
## Warning in ks.test(std.groupE_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupE_rs
## D = 0.077805, p-value = 0.3649
## alternative hypothesis: two-sided
# CHECK FOR NORMALITY FOR WRITING SCORE
std.groupA_ws<-scale(data$writing.score[data$race.ethnicity=='group A'])
std.groupB_ws<-scale(data$writing.score[data$race.ethnicity=='group B'])
std.groupC_ws<-scale(data$writing.score[data$race.ethnicity=='group C'])
std.groupD_ws<-scale(data$writing.score[data$race.ethnicity=='group D'])
std.groupE_ws<-scale(data$writing.score[data$race.ethnicity=='group E'])
ks.test(std.groupA_ws,'pnorm')
## Warning in ks.test(std.groupA_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupA_ws
## D = 0.046981, p-value = 0.9894
## alternative hypothesis: two-sided
ks.test(std.groupB_ws,'pnorm')
## Warning in ks.test(std.groupB_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupB_ws
## D = 0.053106, p-value = 0.6575
## alternative hypothesis: two-sided
ks.test(std.groupC_ws,'pnorm')
## Warning in ks.test(std.groupC_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupC_ws
## D = 0.037506, p-value = 0.7606
## alternative hypothesis: two-sided
ks.test(std.groupD_ws,'pnorm')
## Warning in ks.test(std.groupD_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupD_ws
## D = 0.063487, p-value = 0.2416
## alternative hypothesis: two-sided
ks.test(std.groupE_ws,'pnorm')
## Warning in ks.test(std.groupE_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupE_ws
## D = 0.075108, p-value = 0.4085
## alternative hypothesis: two-sided
# CHECK FOR NORMALITY FOR MATH SCORE
std.groupA_ms<-scale(data$math.score[data$race.ethnicity=='group A'])
std.groupB_ms<-scale(data$math.score[data$race.ethnicity=='group B'])
std.groupC_ms<-scale(data$math.score[data$race.ethnicity=='group C'])
std.groupD_ms<-scale(data$math.score[data$race.ethnicity=='group D'])
std.groupE_ms<-scale(data$math.score[data$race.ethnicity=='group E'])
ks.test(std.groupA_ms,'pnorm')
## Warning in ks.test(std.groupA_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupA_ms
## D = 0.046758, p-value = 0.99
## alternative hypothesis: two-sided
ks.test(std.groupB_ms,'pnorm')
## Warning in ks.test(std.groupB_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupB_ms
## D = 0.056966, p-value = 0.5684
## alternative hypothesis: two-sided
ks.test(std.groupC_ms,'pnorm')
## Warning in ks.test(std.groupC_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupC_ms
## D = 0.05271, p-value = 0.3381
## alternative hypothesis: two-sided
ks.test(std.groupD_ms,'pnorm')
## Warning in ks.test(std.groupD_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupD_ms
## D = 0.055829, p-value = 0.3877
## alternative hypothesis: two-sided
ks.test(std.groupE_ms,'pnorm')
## Warning in ks.test(std.groupE_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.groupE_ms
## D = 0.049428, p-value = 0.8837
## alternative hypothesis: two-sided
As a result of the non-parametric Kolmogorov-Smirnov test with a 95% confidence interval, we may infer that the various scores of each race ethnicity population do not violate the ANOVA test’s normality assumption, since all P-values are greater than 0.05.However, we were hesitant to employ the ANOVA test since the test’s accuracy may be influenced by the different sample group sizes.
As a response, we end up employing the one-way Welch’s ANOVA test, which accounts for the inequality and homogeneity of variances across our sample sizes.
Race/ethnicity influence for the different scores
#perform Welch's ANOVA
oneway.test(data$reading.score ~ data$race.ethnicity, data = data, var.equal = FALSE) #notice that we check with
##
## One-way analysis of means (not assuming equal variances)
##
## data: data$reading.score and data$race.ethnicity
## F = 5.1164, num df = 4.00, denom df = 361.99, p-value = 0.000508
#var.equal= false
#Tukey-Kramer test
TukeyHSD(aov(data$reading.score ~ data$race.ethnicity))
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = data$reading.score ~ data$race.ethnicity)
##
## $`data$race.ethnicity`
## diff lwr upr p adj
## group B-group A 2.6784743 -2.39976087 7.756709 0.6009584
## group C-group A 4.4292910 -0.31009682 9.168679 0.0799351
## group D-group A 5.3563770 0.50583339 10.206921 0.0219169
## group E-group A 8.3544141 2.99470490 13.714123 0.0002170
## group C-group B 1.7508167 -1.87219101 5.373824 0.6784186
## group D-group B 2.6779028 -1.08934583 6.445151 0.2954782
## group E-group B 5.6759398 1.27243316 10.079447 0.0040770
## group D-group C 0.9270861 -2.36919766 4.223370 0.9395630
## group E-group C 3.9251232 -0.08289327 7.933140 0.0582314
## group E-group D 2.9980371 -1.14082421 7.136898 0.2767422
#perform Welch's ANOVA
oneway.test(data$writing.score ~ data$race.ethnicity, data = data, var.equal = FALSE) #notice that we check with
##
## One-way analysis of means (not assuming equal variances)
##
## data: data$writing.score and data$race.ethnicity
## F = 6.9406, num df = 4.00, denom df = 365.05, p-value = 2.151e-05
#var.equal= false
#Tukey-Kramer test
TukeyHSD(aov(data$writing.score ~ data$race.ethnicity))
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = data$writing.score ~ data$race.ethnicity)
##
## $`data$race.ethnicity`
## diff lwr upr p adj
## group B-group A 2.925843 -2.3435724 8.195258 0.5513495
## group C-group A 5.153429 0.2356178 10.071240 0.0346280
## group D-group A 7.470881 2.4377292 12.504033 0.0005145
## group E-group A 8.732986 3.1714998 14.294471 0.0001892
## group C-group B 2.227586 -1.5318166 5.986989 0.4853085
## group D-group B 4.545038 0.6359643 8.454112 0.0132671
## group E-group B 5.807143 1.2378577 10.376428 0.0048638
## group D-group C 2.317452 -1.1029267 5.737831 0.3445476
## group E-group C 3.579557 -0.5793492 7.738463 0.1296283
## group E-group D 1.262105 -3.0325720 5.556781 0.9296838
#perform Welch's ANOVA
oneway.test(data$math.score ~ data$race.ethnicity, data = data, var.equal = FALSE) #notice that we check with
##
## One-way analysis of means (not assuming equal variances)
##
## data: data$math.score and data$race.ethnicity
## F = 13.59, num df = 4.00, denom df = 365.54, p-value = 2.438e-10
#var.equal= false
#Tukey-Kramer test
TukeyHSD(aov(data$math.score ~ data$race.ethnicity))
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = data$math.score ~ data$race.ethnicity)
##
## $`data$race.ethnicity`
## diff lwr upr p adj
## group B-group A 1.823418 -3.35997818 7.006814 0.8723586
## group C-group A 2.834736 -2.00279565 7.672268 0.4968040
## group D-group A 5.733382 0.78239222 10.684372 0.0138238
## group E-group A 12.192215 6.72151591 17.662914 0.0000000
## group C-group B 1.011318 -2.68671543 4.709352 0.9451894
## group D-group B 3.909964 0.06470228 7.755225 0.0440476
## group E-group B 10.368797 5.87410158 14.863492 0.0000000
## group D-group C 2.898646 -0.46589828 6.263189 0.1289617
## group E-group C 9.357479 5.26646348 13.448494 0.0000000
## group E-group D 6.458833 2.23426347 10.683403 0.0003084
To summarize, students from groups D and E outperform students from group A in reading scores, while students from group E appear to outperform group B as well. In terms of writing scores, it was found that students from ethnicities C, D, and E had higher writing scores than students from group A. Students from ethnicity D and E appear to outperform even those from group B. Finally, in respect of math scores, we may infer that group E outperformed groups C, D, B, and A, whereas students from race D outperformed those from groups B and A.
Boxplots for the scores based on the different parental level of education
# boxplot for writing.score
# Using "position=position_dodge()" in order to have a different boxplot per group
boxplot.gender.writing.score <- ggplot(data=data, aes(x=writing.score, y=parental.level.of.education, fill=parental.level.of.education)) +
geom_boxplot() + coord_flip() + theme(axis.text.x=element_blank()) +
labs(title="Box plot for Writing Scores",x="Writing Scores", y = "parental education")
# boxplot for math.score
# Using "position=position_dodge()" in order to have a different boxplot per group
boxplot.gender.math.score <- ggplot(data=data, aes(x=math.score, y=parental.level.of.education, fill=parental.level.of.education)) +
geom_boxplot() + coord_flip() + theme(axis.text.x=element_blank()) +
labs(title="Box plot for Math Scores",x="Math Scores", y = "parental education")
# boxplot for reading.score
# Using "position=position_dodge()" in order to have a different boxplot per group
boxplot.gender.reading.score<- ggplot(data=data, aes(x=reading.score, y=parental.level.of.education, fill=parental.level.of.education)) +
geom_boxplot() + coord_flip() + theme(axis.text.x=element_blank()) +
labs(title="Box plot for Reading Scores", x="Reading Scores", y = "parental education")
# The three defined plots are going to be plotted on this page
ggarrange(boxplot.gender.writing.score, boxplot.gender.math.score, boxplot.gender.reading.score,
ncol = 3, nrow = 1)
In all the themes, it was found that students whose parents had a master’s degree had the highest achievements. Furthermore, individuals whose parents had only completed a high school education or had only completed a high school education did not fare as well as individuals whose parents had a different academic background. One point to note is that the sequence of the results is the same in all courses. Finally, it seems like the medians for individuals whose parents did not fully complete high school, were greater than those students whose parents completed high school. This is somehow strange, and it will examined furthered more.
In order to compare the means of each race ethnicity population and be more exact about our conclusions, we choose to cross-check these data by using a Welch’s ANOVA test (analysis of variance, assuming no equal variances across our sample sizes).
Using Welch’s ANOVA test, it was assessed whether parental level of education had an influence on subject results during the analysis. However, because the test presupposes that the data is normal, it was explored how the populations of the various parental education groups are distributed in order to create Welch’s ANOVA test and determine if parental education background has an impact on subject results of students.
The non-parametric Kolmogorov-Smirnov test was firstly performed to analyse the normality of the distribution for the different scores of each parental level of education population.
### VARIABLE: PARENTAL LEVEL OF EDUCATION
#CHECK FOR NORMALITY reading SCORE
std.BA_rs<-scale(data$reading.score[data$parental.level.of.education=="bachelor's degree"])
std.SC_rs<-scale(data$reading.score[data$parental.level.of.education=='some college'])
std.MD_rs<-scale(data$reading.score[data$parental.level.of.education=="master's degree"])
std.AD_rs<-scale(data$reading.score[data$parental.level.of.education=="associate's degree"])
std.HS_rs<-scale(data$reading.score[data$parental.level.of.education=='high school'])
std.SHS_rs<-scale(data$reading.score[data$parental.level.of.education=='some high school'])
ks.test(std.BA_rs,'pnorm')
## Warning in ks.test(std.BA_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.BA_rs
## D = 0.062972, p-value = 0.7376
## alternative hypothesis: two-sided
ks.test(std.SC_rs,'pnorm')
## Warning in ks.test(std.SC_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.SC_rs
## D = 0.051415, p-value = 0.5887
## alternative hypothesis: two-sided
ks.test(std.MD_rs,'pnorm')
## Warning in ks.test(std.MD_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.MD_rs
## D = 0.071291, p-value = 0.9252
## alternative hypothesis: two-sided
ks.test(std.AD_rs,'pnorm')
## Warning in ks.test(std.AD_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.AD_rs
## D = 0.059382, p-value = 0.4141
## alternative hypothesis: two-sided
ks.test(std.HS_rs,'pnorm')
## Warning in ks.test(std.HS_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.HS_rs
## D = 0.054308, p-value = 0.6098
## alternative hypothesis: two-sided
ks.test(std.SHS_rs,'pnorm')
## Warning in ks.test(std.SHS_rs, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.SHS_rs
## D = 0.047623, p-value = 0.8116
## alternative hypothesis: two-sided
#CHECK FOR NORMALITY WRITING
std.BA_ws<-scale(data$writing.score[data$parental.level.of.education=="bachelor's degree"])
std.SC_ws<-scale(data$writing.score[data$parental.level.of.education=='some college'])
std.MD_ws<-scale(data$writing.score[data$parental.level.of.education=="master's degree"])
std.AD_ws<-scale(data$writing.score[data$parental.level.of.education=="associate's degree"])
std.HS_ws<-scale(data$writing.score[data$parental.level.of.education=='high school'])
std.SHS_ws<-scale(data$writing.score[data$parental.level.of.education=='some high school'])
ks.test(std.BA_ws,'pnorm')
## Warning in ks.test(std.BA_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.BA_ws
## D = 0.046884, p-value = 0.9577
## alternative hypothesis: two-sided
ks.test(std.SC_ws,'pnorm')
## Warning in ks.test(std.SC_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.SC_ws
## D = 0.053277, p-value = 0.5426
## alternative hypothesis: two-sided
ks.test(std.MD_ws,'pnorm')
## Warning in ks.test(std.MD_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.MD_ws
## D = 0.079012, p-value = 0.855
## alternative hypothesis: two-sided
ks.test(std.AD_ws,'pnorm')
## Warning in ks.test(std.AD_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.AD_ws
## D = 0.053846, p-value = 0.5404
## alternative hypothesis: two-sided
ks.test(std.HS_ws,'pnorm')
## Warning in ks.test(std.HS_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.HS_ws
## D = 0.064248, p-value = 0.3935
## alternative hypothesis: two-sided
ks.test(std.SHS_ws,'pnorm')
## Warning in ks.test(std.SHS_ws, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.SHS_ws
## D = 0.080533, p-value = 0.196
## alternative hypothesis: two-sided
#CHECK FOR NORMALITY MATH
std.BA_ms<-scale(data$math.score[data$parental.level.of.education=="bachelor's degree"])
std.SC_ms<-scale(data$math.score[data$parental.level.of.education=='some college'])
std.MD_ms<-scale(data$math.score[data$parental.level.of.education=="master's degree"])
std.AD_ms<-scale(data$math.score[data$parental.level.of.education=="associate's degree"])
std.HS_ms<-scale(data$math.score[data$parental.level.of.education=='high school'])
std.SHS_ms<-scale(data$math.score[data$parental.level.of.education=='some high school'])
ks.test(std.BA_ms,'pnorm')
## Warning in ks.test(std.BA_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.BA_ms
## D = 0.05844, p-value = 0.8151
## alternative hypothesis: two-sided
ks.test(std.SC_ms,'pnorm')
## Warning in ks.test(std.SC_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.SC_ms
## D = 0.062697, p-value = 0.3367
## alternative hypothesis: two-sided
ks.test(std.MD_ms,'pnorm')
## Warning in ks.test(std.MD_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.MD_ms
## D = 0.1246, p-value = 0.3189
## alternative hypothesis: two-sided
ks.test(std.AD_ms,'pnorm')
## Warning in ks.test(std.AD_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.AD_ms
## D = 0.058941, p-value = 0.4235
## alternative hypothesis: two-sided
ks.test(std.HS_ms,'pnorm')
## Warning in ks.test(std.HS_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.HS_ms
## D = 0.06599, p-value = 0.3606
## alternative hypothesis: two-sided
ks.test(std.SHS_ms,'pnorm')
## Warning in ks.test(std.SHS_ms, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: std.SHS_ms
## D = 0.081576, p-value = 0.1845
## alternative hypothesis: two-sided
It was deduced, that the varied scores of each parental level of education population do not violate the ANOVA test’s normality assumption since all P-values are larger than 0.05 as a result of the non-parametric Kolmogorov-Smirnov test with a 95 percent confidence interval. However, it was concerned to use the ANOVA test since the accuracy of the test may be altered by sample group sizes.
As a result, the one-way Welch’s ANOVA test was used, which consider the population inequality and variance homogeneity across sample sizes.
## ANALYSIS OF VARIANCE (ANOVA)
#->Hypotheses: Affection of parental level of education on total score
#H0: There is no statistical difference in the total score mean between each parental level of education.
#H1: There is a statistical difference in the total score mean between each parental level of education.
#perform Welch's ANOVA
oneway.test(data$reading.score ~ data$parental.level.of.education, data = data, var.equal = FALSE) #notice that we check with
##
## One-way analysis of means (not assuming equal variances)
##
## data: data$reading.score and data$parental.level.of.education
## F = 9.398, num df = 5.0, denom df = 339.4, p-value = 2.108e-08
#var.equal= false
#Tukey-Kramer test
TukeyHSD(aov(data$reading.score ~ data$parental.level.of.education))
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = data$reading.score ~ data$parental.level.of.education)
##
## $`data$parental.level.of.education`
## diff lwr upr p adj
## high school-some high school -2.234466 -6.45766511 1.988733 0.6574517
## some college-some high school 2.521630 -1.56558345 6.608842 0.4912798
## associate's degree-some high school 3.989380 -0.11407454 8.092835 0.0622049
## bachelor's degree-some high school 6.061453 1.21759683 10.905308 0.0049602
## master's degree-some high school 8.434334 2.30213195 14.566536 0.0012867
## some college-high school 4.756095 0.76901986 8.743171 0.0089453
## associate's degree-high school 6.223846 2.22012251 10.227570 0.0001463
## bachelor's degree-high school 8.295918 3.53625460 13.055582 0.0000113
## master's degree-high school 10.668800 4.60288168 16.734718 0.0000090
## associate's degree-some college 1.467751 -2.39226226 5.327764 0.8871557
## bachelor's degree-some college 3.539823 -1.09960551 8.179252 0.2486973
## master's degree-some college 5.912704 -0.05933545 11.884744 0.0541073
## bachelor's degree-associate's degree 2.072072 -2.58167159 6.725816 0.8006901
## master's degree-associate's degree 4.444953 -1.53821401 10.428121 0.2770595
## master's degree-bachelor's degree 2.372881 -4.14040412 8.886167 0.9042540
#perform Welch's ANOVA
oneway.test(data$writing.score ~ data$parental.level.of.education, data = data, var.equal = FALSE) #notice that we check with
##
## One-way analysis of means (not assuming equal variances)
##
## data: data$writing.score and data$parental.level.of.education
## F = 15.12, num df = 5.00, denom df = 340.57, p-value = 2.031e-13
#var.equal= false
#Tukey-Kramer test
TukeyHSD(aov(data$writing.score ~ data$parental.level.of.education))
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = data$writing.score ~ data$parental.level.of.education)
##
## $`data$parental.level.of.education`
## diff lwr upr p adj
## high school-some high school -2.439289 -6.7812971 1.902720 0.5960379
## some college-some high school 3.952440 -0.2497568 8.154636 0.0790042
## associate's degree-some high school 5.008128 0.7892327 9.227024 0.0094688
## bachelor's degree-some high school 8.493088 3.5129622 13.473213 0.0000192
## master's degree-some high school 10.789698 4.4849817 17.094414 0.0000177
## some college-high school 6.391728 2.2924864 10.490970 0.0001376
## associate's degree-high school 7.447417 3.3310582 11.563775 0.0000043
## bachelor's degree-high school 10.932376 6.0388112 15.825941 0.0000000
## master's degree-high school 13.228987 6.9924189 19.465554 0.0000000
## associate's degree-some college 1.055688 -2.9129167 5.024294 0.9740854
## bachelor's degree-some college 4.540648 -0.2292994 9.310595 0.0725881
## master's degree-some college 6.837258 0.6972098 12.977307 0.0189417
## bachelor's degree-associate's degree 3.484960 -1.2997057 8.269625 0.2987656
## master's degree-associate's degree 5.781570 -0.3699194 11.933059 0.0794141
## master's degree-bachelor's degree 2.296610 -4.3999105 8.993131 0.9245528
#perform Welch's ANOVA
oneway.test(data$math.score ~ data$parental.level.of.education, data = data, var.equal = FALSE) #notice that we check with
##
## One-way analysis of means (not assuming equal variances)
##
## data: data$math.score and data$parental.level.of.education
## F = 6.4939, num df = 5.00, denom df = 338.04, p-value = 8.792e-06
#var.equal= false
#Tukey-Kramer test
TukeyHSD(aov(data$math.score ~ data$parental.level.of.education))
## Tukey multiple comparisons of means
## 95% family-wise confidence level
##
## Fit: aov(formula = data$math.score ~ data$parental.level.of.education)
##
## $`data$parental.level.of.education`
## diff lwr upr p adj
## high school-some high school -1.3594516 -5.77493356 3.056030 0.9514996
## some college-some high school 3.6311119 -0.64219230 7.904416 0.1481784
## associate's degree-some high school 4.3856762 0.09539047 8.675962 0.0417546
## bachelor's degree-some high school 5.8926238 0.82822687 10.957021 0.0118857
## master's degree-some high school 6.2485560 -0.16284570 12.659958 0.0610615
## some college-high school 4.9905635 0.82195602 9.159171 0.0085748
## associate's degree-high school 5.7451278 1.55911404 9.931142 0.0013308
## bachelor's degree-high school 7.2520754 2.27570365 12.228447 0.0004918
## master's degree-high school 7.6080076 1.26590769 13.950108 0.0083719
## associate's degree-some college 0.7545643 -3.28119570 4.790324 0.9947937
## bachelor's degree-some college 2.2615119 -2.58915025 7.112174 0.7676188
## master's degree-some college 2.6174441 -3.62650328 8.861392 0.8384321
## bachelor's degree-associate's degree 1.5069476 -3.35868146 6.372577 0.9502834
## master's degree-associate's degree 1.8628798 -4.39270184 8.118461 0.9578456
## master's degree-bachelor's degree 0.3559322 -6.45390383 7.165768 0.9999897
To summarize, students for whom the parents have a some college diploma, an associate degree, a bachelor’s degree, or a master’s degree outperform students whose parents only have a high school diploma in reading scores, while students whose parents have a bachelor’s degree and a master’s degree appear to outperform students whose parents only have a some high school education. In terms of writing scores, we found that students whose their parents had some college diploma, an associate degree or bachelor’s degree, or a master’s degree achieved higher writing scores than students whose their parents had only high school background. Additionally, students whose their parents had an education from the associate degree and beyond, appear to outperform even those whose their parents had partially completed high school. Finally, we may deduce that the parental level of education corresponds with math scores has the same manner as it does with writing scores.
In the direction of feeding the data into different regression models-algorithms, a specific pre-processing procedure should have been followed. In order to feed the data to a regression model, the categorical-factor variables-columns were transformed to one-hot (dummy) variables or numerical variables.
Accurately, during the pre-processing steps, the factor-categorical variables gender, race.ethnicity and lunch were transformed to dummy variables. The reason for that, is due to the fact that for categorical variables where no such ordinal relationship exists, the numerical encoding is not enough. Using the numerical encoding and allowing a model to assume a natural ordering between categories may result in poor performance or unexpected results . For that case, a one-hot encoding was applied to the ordinal representation. This is where the factor encoded variables were removed, and one new binary variable was added for each unique value of the variables. In addition, since linear models were also employed, only the \(n-1\) out of the \(n\) new binary variables were kept for each one of the initial categorical variables. To make it clear, for each initial variable, one of its \(n\) binary variables was kept out in to avoid the “dummy variable trap”; a scenario in linear models where the independent variables are multicollinear (highly correlated), since one variable is statistically/informationally redundant, and contains no additional information. The removed argument can be set to indicate which category will become the one that is assigned all zero values, called the “baseline“, since it is used as the reference group.
A summary of the encoded variables is presented below.
# In order to feed the data to a regression model, the categorical-factor variables-columns should be transformed to one-hot variables or numerical variables
# For the parental education, as it was previously mentioned, the factors were sorted from low to high education. Therefore the column can easily be transformed to numerical
# Converting a factor into a numeric vector
data$parental.level.of.education <- as.numeric(data$parental.level.of.education)
# Applying one-hot encoding for the rest of the categorical variables
# For the categorical-factor variables, the n-1 of the n constructed one-hot columns are kept,
# since the most frequent dummy variable is removed in order to avoid multicollinearity problems (when independent variables in the regression model are highly correlated to each other)
# The one.hot.data dataframe will have 11 total variables after the encoding, since the library fastDummies creates four dummy variables from the categorical variable race.ethnicity by removing the most frequent dummy, which was the group C.
one.hot.data <- fastDummies::dummy_cols(data, remove_selected_columns=TRUE, remove_most_frequent_dummy=TRUE)
# Structure of the new dataframe
str(one.hot.data)
## 'data.frame': 1000 obs. of 11 variables:
## $ parental.level.of.education : num 5 3 6 4 3 4 3 3 2 2 ...
## $ math.score : int 72 69 90 47 76 71 88 40 64 38 ...
## $ reading.score : int 72 90 95 57 78 83 95 43 64 60 ...
## $ writing.score : int 74 88 93 44 75 78 92 39 67 50 ...
## $ gender_male : int 0 0 0 1 1 0 0 1 1 0 ...
## $ race.ethnicity_group A : int 0 0 0 1 0 0 0 0 0 0 ...
## $ race.ethnicity_group B : int 1 0 1 0 0 1 1 1 0 1 ...
## $ race.ethnicity_group D : int 0 0 0 0 0 0 0 0 1 0 ...
## $ race.ethnicity_group E : int 0 0 0 0 0 0 0 0 0 0 ...
## $ lunch_free/reduced : int 0 0 0 1 0 0 0 1 1 1 ...
## $ test.preparation.course_completed: int 0 1 0 0 0 0 1 0 1 0 ...
In our case, the binary variable of the most frequent category-group for a specific variable was kept out as the reference group. For example regarding the race.ethnicity variable, group C was omitted from the transformed data.frame, since as elucidated that group C was the most frequent among the ethnicities. The same procedure has been performed for each categorical variable in the data, in order to eliminate the perfect multicollinearity between the explanatory variables. In the special case of the parental.level.of.education variable, even though the variable was initially a categorical variable, it was reasonable for its different levels-values to follow a specific order, thus the specific variable was not encoded with one-hot representation. Instead, it was numerical encoded according to its sorted values, as it was explained before.
Following, a plot of the correlation of every pair of variables in the dataset has been constructed.
# Use of the command cor() to find the correlation of every pair of variables in the data
cor_matrix <- cor(one.hot.data, use='everything')
# Using the corrplot() command which shows graphically the correlation between the variables
par(mfrow=c(1,1))
col <- colorRampPalette(c("#BB4444", "#EE9988", "#FFFFFF", "#77AADD", "#4477AA"))
corrplot(cor_matrix, method="color", col=col(200), number.cex = 0.9, order="hclust", addCoef.col = "black", tl.col="black", tl.srt=45, diag=FALSE)
Following, a plot of the correlation of every pair of variables in the dataset has been constructed. The correlation plot provided useful information for the variables. Indeed, as shown in the correlation plot, the three scores are strongly correlated, which shows that in general, students that perform good in the exams for a particular subject, tend to perform good in the rest of the subjects as well. Especially for the writing and reading scores, where their linear relationship is highly correlated (95% correlation). Moreover, it can be seen that the variables gender.male, parental level of education and test preparation course reported significantly more than the variables groupA and groupB.
Regarding the high correlation between the score variables, multi-collinearity (high correlation) usually leads to wrong conclusions in a linear regression model, because the distinction between the individual effects of the independent variables on the dependent variable is not possible. Therefore, that was taken into consideration during the next steps of the work.
Next, the the linear models which will predict students’ performance in Maths, Reading and Writing were created. The representation is a linear equation that combines a specific set of independent (explanatory) variables the solution to which is the predicted output for that set of input values.
Before initializing the models, the data was scaled (standardized to have zero mean and standard deviation of one) in order to compare the coefficients after the model has been constructed.
# Scaling data using z-score standardization
scaled.one.hot.data <- as.data.frame(scale(one.hot.data))
Firstly, the linear model is created for the math scores.
# Linear model for Maths' score
linear_model <- lm(math.score~., data=scaled.one.hot.data)
# The Variance Inflation Factor (VIF) measures the severity of multicollinearity in regression analysis. Mathematically, the VIF for a regression model variable is equal to the ratio of the overall model variance to the variance of a model that includes only that single independent variable. Generally, if the values of vif are higher than 5, it indicates high correlation.
vif(linear_model)
## parental.level.of.education reading.score
## 1.118638 12.997159
## writing.score gender_male
## 15.041512 1.199324
## `race.ethnicity_group A` `race.ethnicity_group B`
## 1.182384 1.301199
## `race.ethnicity_group D` `race.ethnicity_group E`
## 1.399629 1.253469
## `lunch_free/reduced` test.preparation.course_completed
## 1.114144 1.249782
# From the results (vif>10) it was concluded that there is linear correlation between the variables reading and writing score with other independent variables or with each other.
# Although only one of these strongly correlated predictors could have been removed from the model in order to avoid multi-collinearity, it was chosen to drop both scores. The same steps have been followed for the construction of all the following linear models. The reason that it was chosen to drop both scores for each linear model is that it was assumed that the evaluation of the students' performance in each subject was done in a specific period of time (e.g. same exam period or semester). So, in our way of thinking it was chosen not to take as granted that the evaluations for the other two tests have been done, for each linear model, because some of the predictions will be taken as given data.
# Linear model for Maths' score (without any other scoring variable included)
linear_model <- lm(math.score~. -reading.score-writing.score, data = scaled.one.hot.data)
# Now it was obvious that the results of vif for each variable do not exceed the level of acceptance.
vif(linear_model)
## parental.level.of.education gender_male
## 1.014624 1.011373
## `race.ethnicity_group A` `race.ethnicity_group B`
## 1.179739 1.299147
## `race.ethnicity_group D` `race.ethnicity_group E`
## 1.350876 1.245234
## `lunch_free/reduced` test.preparation.course_completed
## 1.005152 1.006107
linear_model
##
## Call:
## lm(formula = math.score ~ . - reading.score - writing.score,
## data = scaled.one.hot.data)
##
## Coefficients:
## (Intercept) parental.level.of.education
## 4.560e-16 1.605e-01
## gender_male `race.ethnicity_group A`
## 1.632e-01 -4.463e-02
## `race.ethnicity_group B` `race.ethnicity_group D`
## -1.258e-02 8.651e-02
## `race.ethnicity_group E` `lunch_free/reduced`
## 1.773e-01 -3.441e-01
## test.preparation.course_completed
## 1.778e-01
summary(linear_model)
##
## Call:
## lm(formula = math.score ~ . - reading.score - writing.score,
## data = scaled.one.hot.data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.2733 -0.5849 -0.0069 0.6111 2.0546
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 4.560e-16 2.747e-02 0.000 1.00000
## parental.level.of.education 1.605e-01 2.769e-02 5.796 9.11e-09 ***
## gender_male 1.632e-01 2.764e-02 5.903 4.89e-09 ***
## `race.ethnicity_group A` -4.463e-02 2.985e-02 -1.495 0.13523
## `race.ethnicity_group B` -1.258e-02 3.133e-02 -0.401 0.68819
## `race.ethnicity_group D` 8.651e-02 3.195e-02 2.708 0.00688 **
## `race.ethnicity_group E` 1.773e-01 3.067e-02 5.779 1.00e-08 ***
## `lunch_free/reduced` -3.441e-01 2.756e-02 -12.488 < 2e-16 ***
## test.preparation.course_completed 1.778e-01 2.757e-02 6.448 1.77e-10 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8687 on 991 degrees of freedom
## Multiple R-squared: 0.2513, Adjusted R-squared: 0.2453
## F-statistic: 41.58 on 8 and 991 DF, p-value: < 2.2e-16
# Although from the summary table we can see that groups A and B are not statistically significant variables for the linear model linear_model in level of significance a=0.05, we cannot conclude that groups A and B do not provide many information. These assumptions may be caused due to multi-collinearity between some variables.
A barplot with the sorted (by absolute values) coefficients of the math scores model was plotted.
Since the procedure of coefficient plot was followed for all the score variables, a relative function was implemented in order to avoid code repetition and increase readability.
# The function plots the coefficients of the given linear_model in a sorted (by asbolute value) way
barplot_for_model_coeffs <- function(linear_model, plot_title="Barplot of the Coefficients in Linear Model"){
# Check conditions for the input of the data
stopifnot(class(linear_model) == "lm")
stopifnot(class(plot_title) == "character")
# Barplot of the coefficients of linear_model
model_coefs <- as.data.frame(linear_model$coefficients) # Extracting the information of the model
variables <- row.names(model_coefs) # Get the variable names
coeffs <- model_coefs[,1] # Get the coeff values
model_coefs <- data.frame(variables, coeffs) # Put to a new dataframe
# Plotting only the actual variables and not the Intercept, sorted by their absolute value
ggplot(model_coefs[-(1:1), ], aes(reorder(variables, abs(coeffs)), coeffs)) +
geom_bar(stat = "identity")+
geom_text(aes(label=round(coeffs, 3)), size=5.5) + theme(axis.text.y = element_text(size = 11)) +
ggtitle(plot_title) +
coord_flip()
}
# Calling the function to plot and present the sorted coeffs of the model
barplot_for_model_coeffs(linear_model, plot_title="Barplot of the Coefficients in Linear Model for Maths")
Succeeding, the residuals of the regression should necessarily be normally distributed, to make valid inferences from the regressions. Therefore, a QQ-plot was constructed and the results were also tested with a non-parametric Kolmogorov-Smirnov test, in order to check for normality and confirm the normality assumption of the residuals of the linear model. On top, a test of linearity of the residuals had been performed.
For the above operations, a relative function was implemented to use it multiple times for the other scores as well.
# The function checks for the normality of the residuals for the given linear_model,
# plots a QQ Normal Plot and runs a non-parametric Kolmogorov-Smirnov test for normality hypothesis testing,
# and plots the fitted values vs the resiaduls of the model, to check for linearity
check_normality_of_residuals <- function(linear_model, qq_plot_title= 'Residuals of Linear Model',
hist_plot_title='Histogram of the Residuals of the Linear Model'){
# Check conditions for the input of the data
stopifnot(class(linear_model) == "lm")
stopifnot(class(qq_plot_title) == "character")
stopifnot(class(hist_plot_title) == "character")
# In order to plot two graphs on the same figure
par(mfrow=c(1,3))
# The scaled residuals of the linear model
residuals <- scale(linear_model$residuals)
# QQ-plot with Normal
qqnorm(residuals, main=qq_plot_title, col='deepskyblue4',
xlab='Predicted values', ylab='Actual Values')
qqline(residuals, col='red')
# Histogram of the residuals
hist(residuals, main=hist_plot_title)
# Check for linearity of the residuals for model
# The desired behavior is for the residuals to do not follow a specific pattern
plot(fitted(linear_model), residuals, main='Residual vs Fitted for Model',
xlab='Fitted Values', ylab='Residuals')
axis(side=1, at=seq(0, 100, by=10))
# Confirmation of the results with a non-parametric test:Kolmogorov-Smirnov
ks.test(residuals, 'pnorm')
}
# Calling the function for a QQ Normal Plot and for a non-parametric Kolmogorov-Smirnov test for normality hypothesis testing
check_normality_of_residuals(linear_model, qq_plot_title= 'Residuals of Linear Model for Maths',
hist_plot_title='Histogram of the Residuals of the Linear Model for Maths')
## Warning in ks.test(residuals, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: residuals
## D = 0.022583, p-value = 0.6876
## alternative hypothesis: two-sided
Since the p-value is greater than the significance level a=0.05, the null hypothesis is not rejected, which means that the residuals occurred from the Normal curve. Also there is no pattern in the residual plot. This suggests that a linear relationship between the predictors and the outcome variable can be assumed.
The same steps have been done for the reading, writing score
Linear model for Reading score
# Linear model for Reading score (without any other scoring variables included)
linear_model <- lm(reading.score~. -math.score -writing.score, data = scaled.one.hot.data)
vif(linear_model)
## parental.level.of.education gender_male
## 1.014624 1.011373
## `race.ethnicity_group A` `race.ethnicity_group B`
## 1.179739 1.299147
## `race.ethnicity_group D` `race.ethnicity_group E`
## 1.350876 1.245234
## `lunch_free/reduced` test.preparation.course_completed
## 1.005152 1.006107
linear_model
##
## Call:
## lm(formula = reading.score ~ . - math.score - writing.score,
## data = scaled.one.hot.data)
##
## Coefficients:
## (Intercept) parental.level.of.education
## 1.190e-16 1.775e-01
## gender_male `race.ethnicity_group A`
## -2.443e-01 -4.166e-02
## `race.ethnicity_group B` `race.ethnicity_group D`
## -2.670e-02 5.928e-02
## `race.ethnicity_group E` `lunch_free/reduced`
## 7.791e-02 -2.380e-01
## test.preparation.course_completed
## 2.470e-01
summary(linear_model)
##
## Call:
## lm(formula = reading.score ~ . - math.score - writing.score,
## data = scaled.one.hot.data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.00993 -0.58949 0.03135 0.64249 2.07693
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.190e-16 2.797e-02 0.000 1.0000
## parental.level.of.education 1.775e-01 2.819e-02 6.297 4.55e-10 ***
## gender_male -2.443e-01 2.814e-02 -8.680 < 2e-16 ***
## `race.ethnicity_group A` -4.166e-02 3.039e-02 -1.371 0.1708
## `race.ethnicity_group B` -2.670e-02 3.190e-02 -0.837 0.4028
## `race.ethnicity_group D` 5.928e-02 3.252e-02 1.823 0.0687 .
## `race.ethnicity_group E` 7.791e-02 3.123e-02 2.495 0.0128 *
## `lunch_free/reduced` -2.380e-01 2.806e-02 -8.484 < 2e-16 ***
## test.preparation.course_completed 2.470e-01 2.807e-02 8.800 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8845 on 991 degrees of freedom
## Multiple R-squared: 0.224, Adjusted R-squared: 0.2177
## F-statistic: 35.75 on 8 and 991 DF, p-value: < 2.2e-16
Barplot of the coefficients of the model for the reading scores
# Calling the function to plot and present the sorted coeffs of the model
barplot_for_model_coeffs(linear_model, plot_title="Barplot of the Coefficients in Linear Model for Reading")
Normality checking for the residuals of the model for reading scores
# Calling the function for a QQ Normal Plot and for a non-parametric Kolmogorov-Smirnov test for normality hypothesis testing
check_normality_of_residuals(linear_model, qq_plot_title= 'Residuals of Linear Model for Reading',
hist_plot_title='Histogram of the Residuals of the Linear Model for Reading')
## Warning in ks.test(residuals, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: residuals
## D = 0.03127, p-value = 0.2822
## alternative hypothesis: two-sided
Since the p-value is greater than the significance level a=0.05, the null hypothesis is not rejected, which means that the residuals occurred from the Normal curve. Also there is no pattern in the residual plot. This suggests that a linear relationship between the predictors and the outcome variable can be assumed.
Linear model for Writing score
# Linear model for Writing score (without any other scoring variables included)
linear_model <- lm(writing.score~. -math.score -reading.score, data = scaled.one.hot.data)
vif(linear_model)
## parental.level.of.education gender_male
## 1.014624 1.011373
## `race.ethnicity_group A` `race.ethnicity_group B`
## 1.179739 1.299147
## `race.ethnicity_group D` `race.ethnicity_group E`
## 1.350876 1.245234
## `lunch_free/reduced` test.preparation.course_completed
## 1.005152 1.006107
linear_model
##
## Call:
## lm(formula = writing.score ~ . - math.score - reading.score,
## data = scaled.one.hot.data)
##
## Coefficients:
## (Intercept) parental.level.of.education
## -3.524e-16 2.215e-01
## gender_male `race.ethnicity_group A`
## -3.015e-01 -4.196e-02
## `race.ethnicity_group B` `race.ethnicity_group D`
## -3.224e-02 1.065e-01
## `race.ethnicity_group E` `lunch_free/reduced`
## 6.351e-02 -2.589e-01
## test.preparation.course_completed
## 3.227e-01
summary(linear_model)
##
## Call:
## lm(formula = writing.score ~ . - math.score - reading.score,
## data = scaled.one.hot.data)
##
## Residuals:
## Min 1Q Median 3Q Max
## -3.14538 -0.53122 0.04978 0.57668 1.88168
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -3.524e-16 2.600e-02 0.000 1.000000
## parental.level.of.education 2.215e-01 2.620e-02 8.455 < 2e-16 ***
## gender_male -3.015e-01 2.616e-02 -11.523 < 2e-16 ***
## `race.ethnicity_group A` -4.196e-02 2.825e-02 -1.485 0.137790
## `race.ethnicity_group B` -3.224e-02 2.965e-02 -1.087 0.277155
## `race.ethnicity_group D` 1.065e-01 3.023e-02 3.523 0.000446 ***
## `race.ethnicity_group E` 6.351e-02 2.903e-02 2.188 0.028913 *
## `lunch_free/reduced` -2.589e-01 2.608e-02 -9.928 < 2e-16 ***
## test.preparation.course_completed 3.227e-01 2.609e-02 12.367 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.8222 on 991 degrees of freedom
## Multiple R-squared: 0.3294, Adjusted R-squared: 0.324
## F-statistic: 60.85 on 8 and 991 DF, p-value: < 2.2e-16
Barplot of the coefficients of the model for the writing scores
# Calling the function to plot and present the sorted coeffs of the model
barplot_for_model_coeffs(linear_model, plot_title="Barplot of the Coefficients in Linear Model for Writing")
Normality checking for the residuals of the model for writing scores
# Calling the function for a QQ Normal Plot and for a non-parametric Kolmogorov-Smirnov test for normality hypothesis testing
check_normality_of_residuals(linear_model, qq_plot_title= 'Residuals of Linear Model for Writing',
hist_plot_title='Histogram of the Residuals of the Linear Model for Writing')
## Warning in ks.test(residuals, "pnorm"): ties should not be present for the
## Kolmogorov-Smirnov test
##
## One-sample Kolmogorov-Smirnov test
##
## data: residuals
## D = 0.028561, p-value = 0.3884
## alternative hypothesis: two-sided
Since the p-value is greater than the significance level a=0.05, the null hypothesis is not rejected, which means that the residuals occurred from the Normal curve. Also there is no pattern in the residual plot. This suggests that a linear relationship between the predictors and the outcome variable can be assumed.
Data Partitioning: The train set will contain the 80% of the data, while the test set will have the remaining 20%. The models are going to be built on the training set, and to evaluate its performance and prediction power, the test set is going to be predicted.
# The glmnet library does not support dataframes as input, thus the prediction phase will utilize matrixes as data
one.hot.data <- as.matrix(one.hot.data[])
# Choosing an index for randomly sampling observations for the data partitioning
# Note that a specific seed was set at the start of the work, to ensure reproductibility of the results
index <- sample(1:nrow(one.hot.data), 0.8*nrow(one.hot.data))
train.data <- one.hot.data[index,] # Create the training data, will have 80% of the data (800/1000)
test.data <- one.hot.data[-index,] # Create the test data, will have 20% of the data (200/1000)
Isolate the predictors and target variables. Note that non of the scoring variables are not included in the predictors data.
X_train <- train.data[, !colnames(train.data) %in% c("math.score", "reading.score", "writing.score")]
y_train <- train.data[, colnames(train.data) %in% c("math.score", "reading.score", "writing.score")]
X_test <- test.data[, !colnames(test.data) %in% c("math.score", "reading.score", "writing.score")]
y_test <- test.data[, colnames(test.data) %in% c("math.score", "reading.score", "writing.score")]
In order for the regression algorithm to run smoothly, the data is first scaled-standardized
# Using the caret package in order to standardize the test data as well,
# but with using only the mean and std of the train data. That way, we avoid cheating, by not allowing information
# of the test data to be used during the preprocssesing. Scaling then splitting or scaling each sample with its own parameters for example, is wrong because it makes use of information extracted from the test sample to build the model afterwards.
#library(caret)
# Compute scaling parameters solely on the training samples
X_scale_params <- preProcess(X_train, method = c("center", "scale"))
y_scale_params <- preProcess(y_train, method = c("center", "scale"))
# Standardize both train and test samples with the mean and std of the training portion
X_train <- predict(X_scale_params, X_train)
X_test <- predict(X_scale_params, X_test)
y_train <- predict(y_scale_params, y_train)
y_test <- predict(y_scale_params, y_test)
For the different Linear Models, the glmnet library utilized, which provides efficient procedures for fitting Linear Regression models
In order to get the important features from the coefficients after the model is trained, we will use the lasso regression model.
Lasso regression, or the L1-Regression, is a modification of the linear regression. In lasso, the loss function is modified to minimize the complexity of the model by limiting the sum of the absolute values of the model coefficients (also called the l1-norm). The model has a penalty hyper-parameter ‘lambda’ that is needed to be selected. Using an l1-norm constraint forces some weight values to zero to allow other coefficients to take non-zero values. The ‘lambda’ hyper-parameter is the constant that multiplies the l1 term.
Implementing the function for evaluation and for the model pipeline for Lasso regression
# The evaluation function, which computes R^2, MSE and RMSE from true and predicted values
eval_results <- function(true, predicted) {
SSE <- sum((predicted - true)^2)
SST <- sum((true - mean(true))^2)
R_square <- 1 - SSE / SST
RMSE = sqrt(SSE/length(true))
MSE = (sum(abs(predicted - true))/length(true))
# Return model performance metrics
data.frame(MSE = MSE, RMSE = RMSE, Rsquare = R_square)
}
# Function that rescales a single variable data based on the
# given mean and std of the given variable name of the given preProc object
unPreProc <- function(preProc, data, var_name){
# Check conditions for the input of the data
stopifnot(class(var_name) == "character")
stopifnot(class(preProc) == "preProcess")
#stopifnot((class(data) == "numeric") | (class(data) == "matrix"))
# Rescale the data by multiplying with the std and adding the mean
return ((data * preProc$std[[var_name]] + preProc$mean[[var_name]]))
}
# Lasso regression, or the L1-Regression, is a modification of the linear regression. In lasso, the loss function is modified to minimize the complexity of the model by limiting the sum of the absolute values of the model coefficients (also called the l1-norm).
# The model has a penalty hyper-parameter 'lambda' that is needed to be selected. Using an l1-norm constraint forces some weight values to zero to allow other coefficients to take non-zero values. The 'lambda' hyper-parameter is the constant that multiplies the l1 term.
# The function is used as a pipeline in order to predict a specific given target variable
run_lasso_reg <- function(X_train, y_train, X_test, y_test, cv_folds = 25, target_variable, y_scale_params){
# Firt the optimal hyperparameters will be chosen for the speicific model
# Run the glmnet() model several times for different values of lambda.
# The task of finding the optimal lambda value is automated using the cv.glmnet() function, which peforms a 25-fold cross validation
# to select the optimal hyper-parameter from the given list
lambdas <- 10^seq(2, -3, by = -.1)
# Setting alpha to 1 implements lasso regression
lasso_reg <- cv.glmnet(x = X_train, y = y_train, alpha = 1, lambda = lambdas, nfolds = cv_folds)
#plot(lasso_reg)
# Best model's lambda
optimal_lambda <- lasso_reg$lambda.min
optimal_lambda
# Running the ideal model for all the training data in order to predict the test set
lasso_model <- glmnet(x = X_train, y = y_train, alpha = 1, lambda = optimal_lambda)
# Prediction and evaluation on train data (using original-uscaled target variables)
cat("\nEvaluation metrics for the training data: \n")
predictions_train <- predict(lasso_model, s = optimal_lambda, newx = X_train)
print(eval_results(unPreProc(y_scale_params, y_train, target_variable),
unPreProc(y_scale_params, predictions_train, target_variable)))
# Prediction and evaluation on test data (using original-uscaled target variables)
cat("\nEvaluation metrics for the test data: \n")
predictions_test <- predict(lasso_model, s = optimal_lambda, newx = X_test)
print(eval_results(unPreProc(y_scale_params, y_test, target_variable),
unPreProc(y_scale_params, predictions_test, target_variable)))
# Extracting the coefficients of the model
tmp_coeffs <- coef(lasso_model)
coeffs_df <- data.frame(name = tmp_coeffs@Dimnames[[1]][tmp_coeffs@i + 1], coefficient = tmp_coeffs@x)
# Prints the coefficients sorted in a decreasing order, by their absolute value
cat("\nThe coefficients of the model: \n")
coeffs_to_show <- coeffs_df[sort(abs(coeffs_df$coefficient), decreasing = T, index.return = T)[[2]],]
print(coeffs_to_show)
# Plotting only the actual variables and not the Intercept, sorted by their absolute value
ggplot(head(coeffs_to_show,-1), aes(reorder(name, abs(coefficient)), coefficient)) +
geom_bar(stat = "identity")+
geom_text(aes(label=round(coefficient,3)), vjust=-0.2, size=3.5) +
ggtitle("Barplot of Model Coefficients") +
coord_flip()
}
Running Lasso Regression model for math.score
target_variable <- 'math.score'
run_lasso_reg(X_train, y_train[, target_variable], X_test, y_test[, target_variable],
cv_folds = 25, target_variable = target_variable, y_scale_params)
##
## Evaluation metrics for the training data:
## MSE RMSE Rsquare
## 1 10.6866 13.08032 0.2452424
##
## Evaluation metrics for the test data:
## MSE RMSE Rsquare
## 1 10.26845 13.34649 0.2440887
##
## The coefficients of the model:
## name coefficient
## 7 lunch_free/reduced -3.248569e-01
## 8 test.preparation.course_completed 1.923138e-01
## 6 race.ethnicity_group E 1.779702e-01
## 3 gender_male 1.451457e-01
## 2 parental.level.of.education 1.435220e-01
## 5 race.ethnicity_group D 7.202107e-02
## 4 race.ethnicity_group A -5.949090e-02
## 1 (Intercept) -1.340143e-16
Running Lasso Regression model for reading.score
target_variable <- 'reading.score'
run_lasso_reg(X_train, y_train[, target_variable], X_test, y_test[, target_variable],
cv_folds = 25, target_variable = target_variable, y_scale_params)
##
## Evaluation metrics for the training data:
## MSE RMSE Rsquare
## 1 10.44318 12.85881 0.2268147
##
## Evaluation metrics for the test data:
## MSE RMSE Rsquare
## 1 10.01536 12.9109 0.1826533
##
## The coefficients of the model:
## name coefficient
## 9 test.preparation.course_completed 2.646419e-01
## 3 gender_male -2.502808e-01
## 8 lunch_free/reduced -2.190871e-01
## 2 parental.level.of.education 1.726376e-01
## 7 race.ethnicity_group E 8.139788e-02
## 4 race.ethnicity_group A -6.154883e-02
## 6 race.ethnicity_group D 5.046799e-02
## 5 race.ethnicity_group B -1.564759e-02
## 1 (Intercept) 2.027114e-17
Running Lasso Regression model for writing.score
target_variable <- 'writing.score'
run_lasso_reg(X_train, y_train[, target_variable], X_test, y_test[, target_variable],
cv_folds = 25, target_variable = target_variable, y_scale_params)
##
## Evaluation metrics for the training data:
## MSE RMSE Rsquare
## 1 10.04566 12.37056 0.3342604
##
## Evaluation metrics for the test data:
## MSE RMSE Rsquare
## 1 9.793672 12.76458 0.2832213
##
## The coefficients of the model:
## name coefficient
## 9 test.preparation.course_completed 3.413473e-01
## 3 gender_male -3.086958e-01
## 8 lunch_free/reduced -2.405577e-01
## 2 parental.level.of.education 2.167371e-01
## 6 race.ethnicity_group D 9.915160e-02
## 7 race.ethnicity_group E 6.728732e-02
## 4 race.ethnicity_group A -6.002674e-02
## 5 race.ethnicity_group B -2.490568e-02
## 1 (Intercept) 1.375819e-16
For this work, since the dataset is relatively small, the GBR models were trained with 25-fold cross validation and exhaustive grid-search, in order to fine-tune the hyperparameters n.treesand interaction.depth. For shrinkage, since it was not that computationally expensive to run the models (for the sample size of \(1000\)) for large number of trees \(N\), shrinkage was chosen to be set equal to \(0.1\).
Implementing the function for evaluation and for the model pipeline for Gradient Boosting model.
# Using an ensemble multiple shallow decision trees (low depth level trees) for regression
# Implementation Sources for GB:
# https://topepo.github.io/caret/model-training-and-tuning.html#preproc
# https://www.rdocumentation.org/packages/gbm/versions/2.1.8/topics/gbm
# http://uc-r.github.io/gbm_regression
# For a gradient boosting machine (GBM) model, there are three main tuning parameters:
# number of iterations, i.e. trees, (called n.trees in the gbm function)
# complexity of the tree, called interaction.depth
# learning rate: how quickly the algorithm adapts, called shrinkage
run_gbm_reg <- function(X_train, y_train, X_test, y_test, cv_folds = 25, target_variable, y_scale_params){
# Set the k-fold CV
# (The verboseIter parameters is to print out the progress at each resamlping stage)
tc <- trainControl(method = "repeatedcv", number = cv_folds, repeats = 1, verbose=FALSE)
# Set the hyper-parameters to tune during the grid-search
gbmGrid <- expand.grid(interaction.depth = (1:4), n.trees = (3:40)*5,
shrinkage = 0.1, n.minobsinnode = 10)
# Train the model with the k-fold cross validation
set.seed(420)
print("Training GB model with k-fold cross validation, will take some time")
gboost_model <- train(x = X_train, y = y_train, method="gbm",
tuneGrid = gbmGrid, trControl=tc, maximize = FALSE, verbose=FALSE)
# Shows the model training and parameter search procedure during k-fold cross validation
# gboost_model
# Prediction and evaluation on training data (using original-uscaled target variables)
cat("\nEvaluation metrics for the training data: \n")
predictions_train <- predict(gboost_model, X_train)
print(eval_results(unPreProc(y_scale_params, y_train, target_variable),
unPreProc(y_scale_params, predictions_train, target_variable)))
# Prediction and evaluation on test data (using original-uscaled target variables)
cat("\nEvaluation metrics for the test data: \n")
predictions_test <- predict(gboost_model, X_test)
print(eval_results(unPreProc(y_scale_params, y_test, target_variable),
unPreProc(y_scale_params, predictions_test, target_variable)))
# Prints and plots the variable importances
# Using scale false in order to see the actual importannces and not the relative ones
plot(varImp(gboost_model, scale=FALSE))
}
Running Gradient Boosting Regression model for math.score
target_variable <- 'math.score'
run_gbm_reg(X_train, y_train[, target_variable], X_test, y_test[, target_variable],
cv_folds = 25, target_variable = target_variable, y_scale_params)
## [1] "Training GB model with k-fold cross validation, will take some time"
##
## Evaluation metrics for the training data:
## MSE RMSE Rsquare
## 1 10.70928 13.06156 0.2474052
##
## Evaluation metrics for the test data:
## MSE RMSE Rsquare
## 1 10.20311 13.26858 0.252889
Running Gradient Boosting Regression model for reading.score
target_variable <- 'reading.score'
run_gbm_reg(X_train, y_train[, target_variable], X_test, y_test[, target_variable],
cv_folds = 25, target_variable = target_variable, y_scale_params)
## [1] "Training GB model with k-fold cross validation, will take some time"
##
## Evaluation metrics for the training data:
## MSE RMSE Rsquare
## 1 10.43761 12.85061 0.2278014
##
## Evaluation metrics for the test data:
## MSE RMSE Rsquare
## 1 9.936513 12.83107 0.1927295
Running Gradient Boosting Regression model for writing.score
target_variable <- 'writing.score'
run_gbm_reg(X_train, y_train[, target_variable], X_test, y_test[, target_variable],
cv_folds = 25, target_variable = target_variable, y_scale_params)
## [1] "Training GB model with k-fold cross validation, will take some time"
##
## Evaluation metrics for the training data:
## MSE RMSE Rsquare
## 1 10.02997 12.34585 0.3369183
##
## Evaluation metrics for the test data:
## MSE RMSE Rsquare
## 1 9.746455 12.67908 0.2927921
Finally, the top and lowest scores are going to be checked manually for the total score:
data.temp <-data.frame(data)
data.temp$total <- data.temp$writing.score + data.temp$math.score + data.temp$reading.score
kable(head(data.temp[order(data.temp$total),], 10))
| gender | race.ethnicity | parental.level.of.education | lunch | test.preparation.course | math.score | reading.score | writing.score | total | |
|---|---|---|---|---|---|---|---|---|---|
| 60 | female | group C | 1 | free/reduced | none | 0 | 17 | 10 | 27 |
| 981 | female | group B | 2 | free/reduced | none | 8 | 24 | 23 | 55 |
| 597 | male | group B | 2 | free/reduced | none | 30 | 24 | 15 | 69 |
| 328 | male | group A | 3 | free/reduced | none | 28 | 23 | 19 | 70 |
| 18 | female | group B | 1 | free/reduced | none | 18 | 32 | 28 | 78 |
| 77 | male | group E | 1 | standard | none | 30 | 26 | 22 | 78 |
| 602 | female | group C | 2 | standard | none | 29 | 29 | 30 | 88 |
| 339 | female | group B | 1 | free/reduced | none | 24 | 38 | 27 | 89 |
| 788 | female | group B | 3 | standard | none | 19 | 38 | 32 | 89 |
| 212 | male | group C | 3 | free/reduced | none | 35 | 28 | 27 | 90 |
kable(head(data.temp[order(-data.temp$total),], 10))
| gender | race.ethnicity | parental.level.of.education | lunch | test.preparation.course | math.score | reading.score | writing.score | total | |
|---|---|---|---|---|---|---|---|---|---|
| 459 | female | group E | 5 | standard | none | 100 | 100 | 100 | 300 |
| 917 | male | group E | 5 | standard | completed | 100 | 100 | 100 | 300 |
| 963 | female | group E | 4 | standard | none | 100 | 100 | 100 | 300 |
| 115 | female | group E | 5 | standard | completed | 99 | 100 | 100 | 299 |
| 180 | female | group D | 1 | standard | completed | 97 | 100 | 100 | 297 |
| 713 | female | group D | 3 | standard | none | 98 | 100 | 99 | 297 |
| 166 | female | group C | 5 | standard | completed | 96 | 100 | 100 | 296 |
| 626 | male | group D | 3 | standard | completed | 100 | 97 | 99 | 296 |
| 150 | male | group E | 4 | free/reduced | completed | 100 | 100 | 93 | 293 |
| 686 | female | group E | 6 | standard | completed | 94 | 99 | 100 | 293 |